Ambas as máquinas estão executando versões de 64 bits do Windows 7. O projeto foi dolorosamente montado, eu não sou um programador.
A função do projeto é pesquisar automaticamente os anexos de emails em um conjunto de lembretes para disparar todas as noites e fazer download apenas de anexos para o caminho especificado que tenha a sequência definida pelas duas pos linhas de código. Basicamente, ele apenas verifica se o nome do arquivo contém o nome / frase desejado. Os arquivos com os quais estou trabalhando mudam um pouco a cada e-mail e ao longo dos anos, mas sempre contém uma única instrução. Se o e-mail foi unRead , ele será marcado como read quando for feito com todos os anexos em cada e-mail.
A única outra diferença é que a máquina com o Outlook 2010 tem algum outro código em execução. Coloquei esse código na máquina com o Outlook 2013 para ver se estava em conflito, mas ele ficou perfeitamente parado.
O código a seguir funciona perfeitamente na máquina com o Outlook 2013, mas não na máquina com o Outlook 2010. O projeto compila muito bem, e runs , mas não baixa nenhum arquivo nem marca nenhum email como não lido. / p>
Aqui está o código em 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
E aqui está o código que eu tenho em Module1 , isso é apenas por causa do código pré-existente na outra máquina. Eu sei que não tem que estar no módulo.
Aqui está:
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