VBA 项目在装有 outlook 2013 的机器上运行良好,但在 运行 outlook 2010 机器上运行不正常
VBA project works fine on machine with outlook 2013, but not on a machine running outlook 2010
两台机器都是运行 64位版本的Win7。项目是痛苦拼凑出来的,我不是程序员。
该项目的功能是在设置为每晚触发的提醒时自动搜索电子邮件中的附件,并且只将附件下载到具有由两行 "pos" 代码定义的字符串的指定路径。基本上它只是检查文件名是否包含所需的 name/phrase。我正在处理的文件随着每一封电子邮件和多年来的变化而略有变化,但始终包含一个声明。如果邮件未读,它会在处理完每封电子邮件中的所有附件后将其标记为已读。
唯一不同的是装有 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
您需要在代码中使用应用属性:
Function GetOutlookApp() As Outlook.Application
' returns reference to native Application object
Set GetOutlookApp = Application
End Function
另外,我建议以逐步的方式调试代码。在指定您在有问题的机器上遇到的确切错误之前,没有人可以帮助您。
I am not a programmer
当前网站面向开发人员,因此我建议至少学习基础知识。参见 Getting Started with VBA in Outlook 2010。
确保 Daily_Report sub 被正确调用。
当所有邮件都进入设置 outlook 的 gmail 帐户收件箱时,我的代码正在查看 Outlook 数据文件 "Inbox"。一旦我通过收件箱 "rule" 将邮件重定向到 "Data File Inbox",代码就可以正常工作。 Daily_Report 子程序被正确调用,应用程序被正确使用。或者,我可能已经重定向我的代码以查看 gmail 收件箱,但不知道如何轻松地做到这一点是编程的业余爱好者。对替代品的任何建议将不胜感激。
两台机器都是运行 64位版本的Win7。项目是痛苦拼凑出来的,我不是程序员。
该项目的功能是在设置为每晚触发的提醒时自动搜索电子邮件中的附件,并且只将附件下载到具有由两行 "pos" 代码定义的字符串的指定路径。基本上它只是检查文件名是否包含所需的 name/phrase。我正在处理的文件随着每一封电子邮件和多年来的变化而略有变化,但始终包含一个声明。如果邮件未读,它会在处理完每封电子邮件中的所有附件后将其标记为已读。
唯一不同的是装有 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
您需要在代码中使用应用属性:
Function GetOutlookApp() As Outlook.Application
' returns reference to native Application object
Set GetOutlookApp = Application
End Function
另外,我建议以逐步的方式调试代码。在指定您在有问题的机器上遇到的确切错误之前,没有人可以帮助您。
I am not a programmer
当前网站面向开发人员,因此我建议至少学习基础知识。参见 Getting Started with VBA in Outlook 2010。
确保 Daily_Report sub 被正确调用。
当所有邮件都进入设置 outlook 的 gmail 帐户收件箱时,我的代码正在查看 Outlook 数据文件 "Inbox"。一旦我通过收件箱 "rule" 将邮件重定向到 "Data File Inbox",代码就可以正常工作。 Daily_Report 子程序被正确调用,应用程序被正确使用。或者,我可能已经重定向我的代码以查看 gmail 收件箱,但不知道如何轻松地做到这一点是编程的业余爱好者。对替代品的任何建议将不胜感激。