公用文件夹在vba

Question

我很努力地找出我如何可以从一个单词宏创建公用文件夹，暂时我正在调试的前景。问题是我的宏将由多个用户运行，因此我无法在“公共文件夹-xxxx@xxx.no”中进行硬编码。那么有没有办法避免这种情况？

Sub AddContactsFolder() 
    Dim myNameSpace As Outlook.NameSpace 
    Dim myFolder As MAPIFolder 
    Dim myNewFolder As MAPIFolder 

    Set myNameSpace = Application.GetNamespace("MAPI") 
    'Set myFolder = myNameSpace.GetDefaultFolder(olFolderContacts) 
    'Set myFolder = myNameSpace.GetSharedDefaultFolder(

    'Set myFolder = GetFolder("Public Folders - xxxx@xxxx.no/All Public Folders/Prototech/") 
    'fails below ..... 
    Set myFolder = GetFolder("Public Folders - *.xxxxx.no/All Public Folders/Prototech/Avd. 150 R&D") '.Folders.Add("Test") 
    Set myNewFolder = myFolder.Folders.Add("AAAAA") 
    End Sub 


    Public Function GetFolder(strFolderPath As String) As MAPIFolder 
     ' strFolderPath needs to be something like 
     ' "Public Folders\All Public Folders\Company\Sales" or 
     ' "Personal Folders\Inbox\My Folder" 

     Dim objApp As Outlook.Application 
     Dim objNS As Outlook.NameSpace 
     Dim colFolders As Outlook.Folders 
     Dim objFolder As Outlook.MAPIFolder 
     Dim arrFolders() As String 
     Dim I As Long 
     On Error Resume Next 

     strFolderPath = Replace(strFolderPath, "/", "\") 
     arrFolders() = Split(strFolderPath, "\") 
     Set objApp = Application 
     Set objNS = objApp.GetNamespace("MAPI") 
     Set objFolder = objNS.Folders.Item(arrFolders(0)) 
     If Not objFolder Is Nothing Then 
     For I = 1 To UBound(arrFolders) 
      Set colFolders = objFolder.Folders 
      Set objFolder = Nothing 
      Set objFolder = colFolders.Item(arrFolders(I)) 
      If objFolder Is Nothing Then 
      Exit For 
      End If 
     Next 
     End If 

     Set GetFolder = objFolder 
     Set colFolders = Nothing 
     Set objNS = Nothing 
     Set objApp = Nothing 
    End Function 

Answer 1

您不需要指定用户。

Sub AddContactsFolder() 

    Dim myNameSpace As Outlook.Namespace 
    Dim myFolder As Folder 
    Dim myNewFolder As Folder 

    Dim TopPublicFolder As Folder 

    Set myNameSpace = Application.GetNamespace("MAPI") 
    Set TopPublicFolder = myNameSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders) 
    Set myFolder = TopPublicFolder.Folders("Prototech").Folders("Avd. 150 R&D") 
    Set myNewFolder = myFolder.Folders.Add("AAAAA") 

End Sub 

Answer 2

遍历Namespace.Stores集合中的所有商店，为每个商店检查Store.ExchangeStoreType属性。对于PF商店，它将是2 (OlExchangeStoreType.olExchangePublicFolder)。然后，您可以从Store.GetRootFolder文件夹开始追溯文件夹层次结构。

Answer 3

这里是字的修改工作代码，由于氡

Sub createPublicFolder(folderName As String) 

Dim OutApp As Object 

Set OutApp = CreateObject("Outlook.Application") 
Dim myNameSpace As Object 
Dim myFolder As Object 
Dim myNewFolder As Object 

Dim TopPublicFolder As Object 

Set myNameSpace = OutApp.GetNamespace("MAPI") 
Set TopPublicFolder = myNameSpace.GetDefaultFolder(18) 
Set myFolder = TopPublicFolder.Folders("Prototech").Folders("Avd. 150 R&D") 
Set myNewFolder = myFolder.Folders.Add(folderName) 
End Sub