M
Mark Ivey
I am trying to create and name a personal folder. The code below will create
the folder and name the STORE or PST filename as I want, but I cannot seem
to figure out how to name the personal folder after (or while) it has been
created. It always shows up as "Personal Folders". Can someone point me in
the right direction?
I want the PST filename and the personal folder name to be the same.
TIA... Mark Ivey
_________________________________________________________________________________
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
Sub Test()
On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Dim myFolder As String
Dim objUserName As String
myFolder = Format(Date, "yyyy")
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objNS.Folders(myFolder)
objUserName = fOSUserName
For Each objItem In Application.ActiveExplorer.Selection
If objFolder Is Nothing Then
objNS.AddStore "C:\Documents and Settings\" & objUserName & "\Local
Settings\Application Data\Microsoft\Outlook\" & myFolder & ".pst"
End If
Next
End Sub
_________________________________________________________________________________
the folder and name the STORE or PST filename as I want, but I cannot seem
to figure out how to name the personal folder after (or while) it has been
created. It always shows up as "Personal Folders". Can someone point me in
the right direction?
I want the PST filename and the personal folder name to be the same.
TIA... Mark Ivey
_________________________________________________________________________________
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
Sub Test()
On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Dim myFolder As String
Dim objUserName As String
myFolder = Format(Date, "yyyy")
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objNS.Folders(myFolder)
objUserName = fOSUserName
For Each objItem In Application.ActiveExplorer.Selection
If objFolder Is Nothing Then
objNS.AddStore "C:\Documents and Settings\" & objUserName & "\Local
Settings\Application Data\Microsoft\Outlook\" & myFolder & ".pst"
End If
Next
End Sub
_________________________________________________________________________________