Question

我正在尝试将电子邮件从收件箱文件夹（名为“A_Classer”）移动到Outlook公用文件夹（目标文件夹的变量名称为olFolder）我尝试了getshareddefaultfolder方法和OpenSharedFolder方法，但我无法解决我的语法问题共享文件夹的名称是“Québec”，它的路径（来自Windows的属性）是（“Dossiers publics - guillaume.hebert@cima.ca/Tous les dossiers publics /Québec”）代码停在：set olFolder ...

下面的代码是我尝试的所有版本

Sub move_to_public_folder()

Dim msg As Outlook.MailItem
Dim olFolder As Outlook.Folder         'public folder where I want the email to be moved
Dim sourceFolder As Outlook.Folder           'current folder of the emails that are to be moved
Dim OlApp As Object

Dim myNamespace As Outlook.Namespace
Dim myRecipient As Outlook.Recipient

Set OlApp = CreateObject("Outlook.Application")                         'Outlook application call
Set myNamespace = OlApp.GetNamespace("MAPI")

Set myRecipient = myNamespace.CreateRecipient("Guillaume Hébert")
myRecipient.Resolve
If myRecipient.Resolved Then
    Cells(1, 1) = Cells(1, 1) + 1
End If

Set olFolder = myNamespace.OpenSharedFolder("Québec")            'FIRST try I made
'Set olFolder = myNamespace.OpenSharedFolder _                    'Second try I made
    '("Dossiers publics - guillaume.hebert@cima.ca/Tous les dossiers publics/Québec")
'Set olFolder = myNamespace.GetSharedDefaultFolder _              'Last try I made
                    '(myRecipient, olPublicFoldersAllPublicFolders)



Set sourceFolder = Session.GetDefaultFolder(sourceFolderInbox)
Set sourceFolder = sourceFolder.Folders("A_Classer")
If sourceFolder Is Nothing Then Exit Sub

I = sourceFolder.Items.Count
nbre_op = I                                                         'détermine combien de courriel dans le répertoire
I = 1
While I <= nbre_op
    Set msg = olFolder.Items(1)
    msg.Move olFolder
    I = I + 1
Wend

Set OlApp = Nothing

End Sub

提前感谢您提供的所有帮助

Answer 1

您是否已连接到Exchange服务器？

如果您使用OpenSharedFolder方法，则需要指定网址。此方法用于访问以下共享文件夹类型：

Webcal日历（webcal：// mysite / mycalendar）
RSS Feed（feed：// mysite / myfeed）
Microsoft SharePoint Foundation文件夹（stssync：// mysite / myfolder）
iCalendar日历（.ics）文件
vCard联系人（.vcf）文件
Outlook邮件（.msg）文件

我建议使用GetSharedDefaultFolder方法，该方法返回一个Folder对象，该对象表示指定用户的指定默认文件夹。例如，您可以获取收件箱文件夹，然后您可以找到所需的文件夹。

运行以下行时，代码会出现什么错误？

'Set olFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olPublicFoldersAllPublicFolders)

Answer 2

发现它！ Tx到@Eugene和@xmojmr。

Sub move_to_public_folder()
    Dim msg As Outlook.MailItem
    Dim olFolder As Outlook.Folder         'source folder
    Dim objFolder As Outlook.Folder         'target folder
    'Dim sourceFolder As Outlook.Folder           'current folder of the emails that are to be moved
    Dim OlApp As Object
    'Dim fldr As Outlook.Folder
    Dim chemin_repertoire_outlook_cible As String       'path containing the target folder

    Dim myNamespace As Outlook.Namespace
    Dim myRecipient As Outlook.Recipient

    Set OlApp = CreateObject("Outlook.Application")                         'Outlook application call
    Set myNamespace = OlApp.GetNamespace("MAPI")

    Set myRecipient = myNamespace.CreateRecipient("Guillaume Hébert")
    myRecipient.Resolve
    If myRecipient.Resolved Then
        Cells(1, 1) = Cells(1, 1) + 1
    End If

    Set OlApp = CreateObject("Outlook.Application")                         'Outlook application call
    Set olFolder = Session.GetDefaultFolder(olFolderInbox)
    Set olFolder = olFolder.Folders("A_Classer")

    lig = 11
    col = 4

    chemin_repertoire_outlook_cible = Cells(lig, col)                'target folder name setting
    Set objFolder = GetFolder(chemin_repertoire_outlook_cible)
    I = olFolder.Items.Count
    nbre_op = I
    I = 1
    While I <= nbre_op                                       'loop to move all msg in source folder (olFolder)
        Set msg = olFolder.Items(1)
        msg.Move objFolder
        I = I + 1
    Wend

 Set OlApp = Nothing
End Sub

GetFolder函数如下

Public Function GetFolder(strFolderPath As String) As MAPIFolder
  ' source of this function is:  http://www.outlookcode.com/d/code/getfolder.htm
  ' 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.Folder
  Dim arrFolders() As String
  Dim I As Long
  On Error Resume Next


  strFolderPath = Replace(strFolderPath, "/", "\")
  arrFolders() = Split(strFolderPath, "\")
  Set objApp = Outlook.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

希望它能在某个时候帮助别人。

Excel VBA，设置Outlook文件夹，这是一个公用文件夹

2 个答案: