Обе машины работают под управлением 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