Question

我正在尝试通过附加了.pdf文件的未读电子邮件查看特定的收件箱，然后将其保存到特定文件夹中。

我需要查看某个帐户个人资料的收件箱。我的代码仅在只有一个收件箱文件夹和一个帐户配置文件时才有效。

假设我有两个档案;

一个是xxxx@hotmail.com

第二个zzzz@hotmail.com

如何在第二个帐户的收件箱中运行代码？（zzzz@hotmail.com）

以下是我到目前为止的代码;

Sub GetAttachments()
On Error GoTo GetAttachments_err

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim varResponse As VbMsgBoxResult

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)

i = 0

' Checks inbox for messages.
If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in your Inbox.", vbInformation, _
"Nothing found"
Exit Sub
End If
' Checks inbox for unread messages.
If Inbox.UnReadItemCount = 0 Then
"Nothing found"
Exit Sub
End If

' Checks for unread messages with .pdf files attached to them, if yes         then saves it to specific folder. _
  Puts date and time from when the mail was created infront of the  filename.
For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
If Item.UnRead = True Then
If Right(Atmt.FileName, 3) = "pdf" Then
FileName = "C:\Users\XXX\Documents\Office Macro\" & _
Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
End If
Next Atmt
Next Item

' Shows how many attached files there are if any are found.
If i > 0 Then
& vbCrLf & "Jag har sparat dem till C:\Users\XXX\Documents\Office Macro folder." _
& vbCrLf & vbCrLf & "Would you like to see your files?" _
vbQuestion + vbYesNo, "Finished!")
 If varResponse = vbYes Then
 Shell "Explorer.exe /e,C:\Users\XXX\Documents\Office Macro\", vbNormalFocus
End If
Else
MsgBox "No attached files could be found.", vbInformation, _
"Finished!"
End If

GetAttachments_exit:
   Set Atmt = Nothing
   Set Item = Nothing
   Set ns = Nothing
   Exit Sub

GetAttachments_err:
   MsgBox "An unkown ghost spooked the program." _
      & vbCrLf & "Please note and report the following information." _
      & vbCrLf & "Macro Name: GetAttachments" _
      & vbCrLf & "Error Number: " & Err.Number _
      & vbCrLf & "Error Description: " & Err.Description _
      , vbCritical, "Error!"
   Resume GetAttachments_exit

Exit Sub

End Sub

在进一步检查邮箱之后，我发现存在一些差异：

xxxx@hotmail.com属于“IMAP / SMTP”类型

zzzz@hotmail.com属于“Exchange ActiveSync”

类型

我还注意到，我需要使用的帐户ID是4，如此代码中所示，当发送带有测试宏的新消息时，通过指定配置文件ID指定要发送邮件的配置文件在剧本中：

Sub Mail_small_Text_Change_Account()
'Only working in Office 2007-2013
'Don't forget to set a reference to Outlook in the VBA editor
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    On Error Resume Next
    With OutMail
        .To = "blabla@blabla.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody

        'SendUsingAccount is new in Office 2007
        'Change Item(1)to the account number that you want to use
        .SendUsingAccount = OutApp.Session.Accounts.Item(4)   <<<< ACCOUNT ID

        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Answer 1

设置收件箱= ns.GetDefaultFolder（olFolderInbox）

您只能使用送货商店的收件箱文件夹来查找商品。

Namespace类的Stores属性返回一个Stores集合对象，该对象表示当前配置文件中的所有Store对象。您可以找到所需的商店，然后使用Store类的GetDefaultFolder方法。此方法类似于NameSpace对象的GetDefaultFolder方法。区别在于此方法获取与该帐户关联的传递存储上的默认文件夹，而NameSpace.GetDefaultFolder返回当前配置文件的默认存储上的默认文件夹。

 Set OutApp = CreateObject("Outlook.Application")
 Set OutMail = OutApp.CreateItem(olMailItem)

无需在Outlook VBA中创建新的Outlook应用程序实例。

Outlook对象模型提供Items类的Find / FindNext或Restrict方法。您还可以发现Application类的AdvancedSearch方法很有帮助。

请参阅第二个帐户的收件箱

1 个答案: