☰

VBA 项目在装有 Outlook 2013 的机器上运行良好，但在运行 Outlook 2010 的机器上却无法运行

tag-icon • tag-icon microsoft-outlook-2010 vba microsoft-outlook-2013
VBA 项目在装有 Outlook 2013 的机器上运行良好，但在运行 Outlook 2010 的机器上却无法运行

两台机器都运行着64位版本的Windows 7。这个项目是痛苦地拼凑起来的，我不是一个程序员。

该项目的功能是，在设置为每晚触发的提醒时自动搜索电子邮件中的附件，并且仅将具有由两pos行代码定义的字符串的附件下载到指定路径。基本上，它只是检查文件名是否包含所需的名称/短语。我正在处理的文件会随着每封电子邮件和多年来的变迁而略有变化，但始终包含一个语句。如果邮件是unRead，它会将其标记为read已完成，其中包含每封电子邮件中的所有附件。

唯一的区别是安装了 Outlook 2010 的机器上确实运行着其他一些代码。我把这段代码放到安装了 Outlook 2013 的机器上，看看是否发生冲突，但它仍然运行正常。

以下代码在装有 Outlook 2013 的机器上运行良好，但在装有 Outlook 2010 的机器上根本无法运行。该项目编译正常，但runs不会下载任何文件，也不会将任何电子邮件标记为未读。

这是代码This Outlook Session

Private WithEvents MyReminders As Outlook.Reminders

Private Sub Application_Startup()
    Set MyReminders = GetOutlookApp.Reminders
End Sub

Function GetOutlookApp() As Outlook.Application
    ' returns reference to native Application object
    Set GetOutlookApp = Outlook.Application
End Function

Private Sub MyReminders_ReminderFire(ByVal ReminderObject As Reminder)
    'On Error GoTo ErrorHandler
    If ReminderObject.Caption = "Daily Report" Then
        ReminderObject.Dismiss
        Daily_Report
    End If

    If ReminderObject.Caption = "Shutdown Outlook" Then
        ReminderObject.Dismiss
        Application.Quit
    End If

 ProgramExit:
     Exit Sub
 ErrorHandler:
      MsgBox Err.Number & " - " & Err.Description
      Resume ProgramExit
 End Sub

这是我在 上的代码Module1，这只是因为另一台机器上已有代码。我知道它不必在模块中。
它在这里：

Sub Daily_Report()
    ' This Outlook macro checks a the Outlook Inbox for messages
    ' with attached files (of any type) and saves them to disk.
    ' NOTE: make sure the specified save folder exists before
    ' running the macro.
    On Error GoTo GetAttachment_err

    ' Declare variables
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileNameXLS As String
    Dim FileNamePDF As String
    Dim posXLS As Integer
    Dim posPDF As Integer

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

    ' Check each message for attachments
    For Each Item In Inbox.Items
         ' Save any attachments found
         If Item.UnRead = True Then
             For Each Atmt In Item.Attachments
                 posXLS = InStr(Atmt.FileName, "FINAL EXCEL")
                 posPDF = InStr(Atmt.FileName, "Final PDF")

                 If posXLS <> 0 And (Right(Atmt.FileName, 4) = ".xls") Or posXLS <> 0 And (Right(Atmt.FileName, 5) = ".xlsx") Then
                     FileNameXLS = "C:\Users\ba\Downloads\Babcok Lab Reports\Babcock Excel\" & Atmt.FileName
                     Atmt.SaveAsFile FileNameXLS
                 End If

                 If posPDF <> 0 And (Right(Atmt.FileName, 4) = ".pdf") Then
                     FileNamePDF = "C:\Users\ba\Downloads\Babcok Lab Reports\Babcock PDF\" & Atmt.FileName
                     Atmt.SaveAsFile FileNamePDF
                 End If
             Next Atmt
             Item.UnRead = False
         End If
     Next Item

' Clear memory
GetAttachment_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
' Handle errors
GetAttachment_err:
    MsgBox "An unexpected error has occurred." _
        & 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 Next
End Sub

答案1

所以，我终于搞明白了。当所有邮件都进入 Outlook 设置的 Gmail 帐户收件箱时，我的代码正在查看 Outlook 数据文件“收件箱”。一旦我通过收件箱“规则”将邮件重定向到“数据文件收件箱”，代码就可以完美运行。或者，我可能已经重定向我的代码以查看 Gmail 收件箱，但作为编程业余爱好者，我不知道如何轻松做到这一点。任何有关替代方案的建议都将不胜感激。

相关内容