bassnsjp
02-06-2013, 09:39 PM
Environment:
Developed the macro using Windows 7 and 2010 Outlook
Transported the macro to Windows XP and 2003 Outlook
Macro purpose:
To process attachments in email, to include the various types of a email (MailItem, AppointmentItem, ContactItem, ReportItem, etc.)
1) The macro traverses through a user selected Outlook folder or processes all Outlook folders
2) The macro checks each email to determine if an attachment exists and then processes it based on the processing type selected by the user
3) The attachment processing options are:
Extract attachments only - which saves them to a directory for later review
Delete attachments only - delete attachements
Extract and Delete attachments - saves and deletes
Compile statistics only
4) Based on the email type information is captured for reporting purposes.
The macro was developed at home and then brought into my place of work. It was working without error at home with 2010 Outlook that has several hundred emails. At work I had to make some very minor changes in order to get it to run. Changes such as the following:
Public Folder As Outlook.Folder to Outlook.MAPIFolder
Public SubFolder As Outlook.Folder to Outlook.MAPIFolder
The environment at work contains thousands of emails. And the macro runs for a while then gets the following error:
Method 'Attachments' of object AppointItem failed
I could understand getting this error if it was the first AppointItem being processed, but the macro literally just processed hunderds of of AppointItem types without error. So, I put some debug in to narrow down where the error was occuring and found that it was between the following statements, because I have On Error Goto Error code that prints the ProcExec.
ProcExec = "Process Email - Stage 1"
ProcExec = "Process Email - Stage 2"
The macro was consistently stopping at the same email. So, I put in some code to stop at the message just before the one causing the error. I then traced the code through several emails with no problems and then let it continue processing which it did for quite a number of emails before encountering another similar error. Following is the procedure in which the error is found. I have been programming in VBA for about 3 years, this is the first time with Outlook and I have to save it is much more difficult than Excel or Word. It appears to me that for whatever reason the code or pointers are getting lost. I've been working on this macro off and on for the last several weeks for a major activity at work and unless I can figure out and resolve what is going on our project will not be able to use it and all the work will be for not. Any help would greatly be appreciated. Thank you very much in advance for your time and efforts.
Sub
ProcessEmail()
'========================================================================== =====================
' This subroutine processes each email and detects if attachments exist and collects information
'========================================================================== =====================
' Capture the email's date and attachment count based on email type
'========================================================================== =====================
ProcExec = "Process Email - Stage 1"
Select Case TypeName(MsgItem)
Case "MailItem", "MeetingItem", "PostItem"
Datefmt1 = Format(MsgItem.SentOn, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.SentOn
Attmcnt = MsgItem.Attachments.Count
Case "ContactItem", "DistListItem", "ReportItem"
Datefmt1 = Format(MsgItem.CreationTime, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.CreationTime
Attmcnt = MsgItem.Attachments.Count
Case "TaskItem", "TaskRequestAcceptItem", "TaskRequestDeclineItem", "TaskRequestItem", "TaskRequestUpdateItem"
Datefmt1 = Format(MsgItem.DueDate, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.DueDate
Attmcnt = MsgItem.Attachments.Count
Case "AppointmentItem", "ContactItem", "JournalItem" ' Believe this is where the error is
Datefmt1 = Format(MsgItem.Start, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.Start
Attmcnt = MsgItem.Attachments.Count
Case "NoteItem"
Datefmt1 = Format(MsgItem.CreationTime, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.CreationTime
Attmcnt = 0
Case Else
Datefmt1 = Format(MsgItem.SentOn, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.SentOn
Attmcnt = MsgItem.Attachments.Count
End Select
'========================================================================== =====================
' Check to see if attachments exist for this email. If so, capture and record statistics in
' the log file and record the action taken within the email, depending on what the attachment
' process option was selected.
'========================================================================== =====================
ProcExec = "Process Email - Stage 2"
If (Attmcnt > 0) Then
Msgnbr = Msgnbr + 1
MsgAttperFld = MsgAttperFld + 1
AttperFld = AttperFld + Attmcnt
AttFilename1 = Username & "_" & AttFolderName & "_" & Datefmt1
' Debug.Print "Msg#: " & Msgnbr & " Msg Type: " & TypeName(MsgItem) & " of attachments: " & Attmcnt & " Subject: " & MsgItem.Subject & " Dated: " & Datefmt2
FSOLogFile.Writeline "Msg#: " & Msgnbr & " Msg Type: " & TypeName(MsgItem) & " # of attachments: " & Attmcnt & " in " & MsgItem.Subject & " Dated: " & Datefmt2
MsgItem.Body = MsgItem.Body & vbCrLf & vbCrLf & String(80, "=")
If (ProcAttm = "Delete") Then
MsgItem.Body = MsgItem.Body & "Following attachment(s) were removed:" &vbCrLf
End If
If (ProcAttm = "ExtrDel") Then
MsgItem.Body = MsgItem.Body & "Attachment(s) were stored out to the following file(s) and removed:" & vbCrLf
End If
End If
End Sub
Developed the macro using Windows 7 and 2010 Outlook
Transported the macro to Windows XP and 2003 Outlook
Macro purpose:
To process attachments in email, to include the various types of a email (MailItem, AppointmentItem, ContactItem, ReportItem, etc.)
1) The macro traverses through a user selected Outlook folder or processes all Outlook folders
2) The macro checks each email to determine if an attachment exists and then processes it based on the processing type selected by the user
3) The attachment processing options are:
Extract attachments only - which saves them to a directory for later review
Delete attachments only - delete attachements
Extract and Delete attachments - saves and deletes
Compile statistics only
4) Based on the email type information is captured for reporting purposes.
The macro was developed at home and then brought into my place of work. It was working without error at home with 2010 Outlook that has several hundred emails. At work I had to make some very minor changes in order to get it to run. Changes such as the following:
Public Folder As Outlook.Folder to Outlook.MAPIFolder
Public SubFolder As Outlook.Folder to Outlook.MAPIFolder
The environment at work contains thousands of emails. And the macro runs for a while then gets the following error:
Method 'Attachments' of object AppointItem failed
I could understand getting this error if it was the first AppointItem being processed, but the macro literally just processed hunderds of of AppointItem types without error. So, I put some debug in to narrow down where the error was occuring and found that it was between the following statements, because I have On Error Goto Error code that prints the ProcExec.
ProcExec = "Process Email - Stage 1"
ProcExec = "Process Email - Stage 2"
The macro was consistently stopping at the same email. So, I put in some code to stop at the message just before the one causing the error. I then traced the code through several emails with no problems and then let it continue processing which it did for quite a number of emails before encountering another similar error. Following is the procedure in which the error is found. I have been programming in VBA for about 3 years, this is the first time with Outlook and I have to save it is much more difficult than Excel or Word. It appears to me that for whatever reason the code or pointers are getting lost. I've been working on this macro off and on for the last several weeks for a major activity at work and unless I can figure out and resolve what is going on our project will not be able to use it and all the work will be for not. Any help would greatly be appreciated. Thank you very much in advance for your time and efforts.
Sub
ProcessEmail()
'========================================================================== =====================
' This subroutine processes each email and detects if attachments exist and collects information
'========================================================================== =====================
' Capture the email's date and attachment count based on email type
'========================================================================== =====================
ProcExec = "Process Email - Stage 1"
Select Case TypeName(MsgItem)
Case "MailItem", "MeetingItem", "PostItem"
Datefmt1 = Format(MsgItem.SentOn, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.SentOn
Attmcnt = MsgItem.Attachments.Count
Case "ContactItem", "DistListItem", "ReportItem"
Datefmt1 = Format(MsgItem.CreationTime, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.CreationTime
Attmcnt = MsgItem.Attachments.Count
Case "TaskItem", "TaskRequestAcceptItem", "TaskRequestDeclineItem", "TaskRequestItem", "TaskRequestUpdateItem"
Datefmt1 = Format(MsgItem.DueDate, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.DueDate
Attmcnt = MsgItem.Attachments.Count
Case "AppointmentItem", "ContactItem", "JournalItem" ' Believe this is where the error is
Datefmt1 = Format(MsgItem.Start, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.Start
Attmcnt = MsgItem.Attachments.Count
Case "NoteItem"
Datefmt1 = Format(MsgItem.CreationTime, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.CreationTime
Attmcnt = 0
Case Else
Datefmt1 = Format(MsgItem.SentOn, "yyyymmdd-HHmmss-AM/PM")
Datefmt2 = MsgItem.SentOn
Attmcnt = MsgItem.Attachments.Count
End Select
'========================================================================== =====================
' Check to see if attachments exist for this email. If so, capture and record statistics in
' the log file and record the action taken within the email, depending on what the attachment
' process option was selected.
'========================================================================== =====================
ProcExec = "Process Email - Stage 2"
If (Attmcnt > 0) Then
Msgnbr = Msgnbr + 1
MsgAttperFld = MsgAttperFld + 1
AttperFld = AttperFld + Attmcnt
AttFilename1 = Username & "_" & AttFolderName & "_" & Datefmt1
' Debug.Print "Msg#: " & Msgnbr & " Msg Type: " & TypeName(MsgItem) & " of attachments: " & Attmcnt & " Subject: " & MsgItem.Subject & " Dated: " & Datefmt2
FSOLogFile.Writeline "Msg#: " & Msgnbr & " Msg Type: " & TypeName(MsgItem) & " # of attachments: " & Attmcnt & " in " & MsgItem.Subject & " Dated: " & Datefmt2
MsgItem.Body = MsgItem.Body & vbCrLf & vbCrLf & String(80, "=")
If (ProcAttm = "Delete") Then
MsgItem.Body = MsgItem.Body & "Following attachment(s) were removed:" &vbCrLf
End If
If (ProcAttm = "ExtrDel") Then
MsgItem.Body = MsgItem.Body & "Attachment(s) were stored out to the following file(s) and removed:" & vbCrLf
End If
End If
End Sub