vba中的公共文件夹 [英] Public folders in vba

问题描述

我正在努力找出如何从 word 宏创建公用文件夹，目前我正在 Outlook 中进行调试.问题是我的宏将由多个用户运行，因此我无法在公共文件夹 [e-mail]"中进行硬编码 那么有没有办法避免这种情况?

I am struggling to find out how i can create public folders from a word macro, for time being i am debugging right in outlook. The problem is that my macro will be run by several user and hence i can not hardcode in "public folders [e-mail]" So is there a way to avoid this?

    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 - [e-mail]/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

推荐答案

您无需指定用户.

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

这篇关于vba中的公共文件夹的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！