Reputation: 31
My code is supposed to check my inbox for unopened emails that contain csv files. When it encounters one it is supposed to download it with a new name and mark the email as read in a new folder.
Everything was working yesterday and now I am getting a run-time error 91.
Option Explicit
Sub SaveAttachments()
Dim myOlapp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Dim myAttachment As Outlook.Attachment
Dim avDate() As String
Dim vDate As String
Dim Address As String
Dim i As Long
Dim j As Long
Dim csvCount As Long
Dim myDestFolder As Outlook.MAPIFolder
Const myPath As String = "C:\Saved CSV\"
ReDim Preserve avDate(3)
Set myOlapp = CreateObject("Outlook.Application")
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
i = 0
j = 0
Set myDestFolder = myFolder.Parent.Folders("CSV Emails")
For i = myFolder.Items.Count To 1 Step -1
If TypeName(myFolder.Items(i)) = "MailItem" Then
Set myItem = myFolder.Items(i)
End If
csvCount = 0
If myItem.UnRead = True Then 'Run time error Here'
avDate = Split(CStr(myItem.ReceivedTime), "/")
vDate = Mid(avDate(2), 1, 4) & "-" & avDate(1) & "-" & avDate(0)
If myItem.Attachments.Count <> 0 Then
For Each myAttachment In myItem.Attachments
If LCase(Right(myAttachment.FileName, 3)) = "csv" Then
j = j + 1
csvCount = csvCount + 1
Dim recipientsItem As Object
Dim OldMessage As Outlook.MailItem
Set OldMessage = ActiveExplorer.Selection.Item(1)
For Each recipientsItem In OldMessage.Recipients
If OldMessage.SenderEmailType = "EX" Then
Address = OldMessage.Sender.GetExchangeUser.PrimarySmtpAddress
End If
If OldMessage.SenderEmailType = "SMTP" Then
Address = mymessage.SenderEmailAddress
End If
Next recipientsItem
myAttachment.SaveAsFile ((myPath) & "," & Address & "," & vDate & " - " & j & " - " & myAttachment.FileName)
End If
Next myAttachment
If csvCount > 0 Then
myItem.UnRead = False
myItem.Move myDestFolder
End If
End If
End If
Next i
SaveAttachments_exit:
Set myAttachment = Nothing
Set myItem = Nothing
Set myNameSpace = Nothing
Set OldMessage = Nothing
Exit Sub
SaveAttachments_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 SaveAttachments_exit
End Sub
I am getting an error on
If myItem.UnRead = True Then
Didn't have the error yesterday. Any help would be appreciated.
I am assuming that it is because the set statement for myItem is within the for loop and it isn't being set properly.
For anyone wondering why I am putting commas in the file name it is so I can extract the senders email address with a -split statement in powershell.
Upvotes: 1
Views: 100
Reputation: 3632
My suspect is that this line Set myItem = myFolder.Items(i)
is never executed, and this will cause your If
instruction to fail accessing the object property.
This can be caused by several reason:
Items.Count = 0
)If
condition is never satisfied (TypeName(myFolder.Items(i))
is never "MailItem"
)MailBox
Item.To test which of this problem can be, I suggest you to run the code in debug mode and executing each instruction step-by-step (you can do it by pressing F8).
While still executing the code, check the value of your variables (using your Local Variable Window).
This can help you better understanding what's going on with your code, and can be a great help in finding where is the issue.
In any case, it's a good practice to check if the object is initialized, before trying accessing it.
To do that, you can add this instruction:
If Not myItem Is Nothing then
If myItem.UnRead = True Then
'rest of your code...
Hope this helps.
Upvotes: 2