公用文件夾在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