R
Ron P
Hi everyone.
I have a macro program that was programmed by someone years ago that I am
trying to figure out how it works. The macro would search the inbox for a
specific subject line of "Workorder", Save the excel attachment to a
directory and then delete the email from the inbox. It has worked for years
as there was only one excel attachment to the email, but now corporate IT
guys have changed email policies and as a result the macro no longer works.
This is due to the email now having 2 attachments, there is the excel
attachment and now an additional txt document attachment. How can I get this
to look at just the Excel attachment? I'm kind of at a loss in trying to
figure out how this person coded. It looks straight forward but I'm
apparently missing something.
Sub ExcelExtract()
Dim Item, Attachments, FolderName As Object
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim Folder As Outlook.MAPIFolder
Dim MailItem As Outlook.MailItem
Set myOlExp = myOlApp.ActiveExplorer
Set nsp = myOlApp.GetNamespace("MAPI")
Set Folder = nsp.GetDefaultFolder(olFolderInbox)
x = 0
itemcount = Folder.Items.Count
For Each myitem In Folder.Items
Set Attachments = myitem.Attachments
If InStr(myitem.Subject, "Workorder") > 0 And
myitem.Attachments.Count > 0 Then mycount = mycount + 1
Next
Workordercount = itemcount - mycount
Do Until Folder.Items.Count = Workordercount
For Each Item In Folder.Items
If InStr(Item.Subject, "Workorder") > 0 Then
Set Attachments = Item.Attachments
If Attachments.Count > 0 Then x = x + 1
For i = 1 To Attachments.Count
Attachments(i).SaveAsFile "C:\Worktemp\Workorder" & x &
".xls"
Item.Delete
Next i
End If
Next
Loop
End Sub
Thanks
I have a macro program that was programmed by someone years ago that I am
trying to figure out how it works. The macro would search the inbox for a
specific subject line of "Workorder", Save the excel attachment to a
directory and then delete the email from the inbox. It has worked for years
as there was only one excel attachment to the email, but now corporate IT
guys have changed email policies and as a result the macro no longer works.
This is due to the email now having 2 attachments, there is the excel
attachment and now an additional txt document attachment. How can I get this
to look at just the Excel attachment? I'm kind of at a loss in trying to
figure out how this person coded. It looks straight forward but I'm
apparently missing something.
Sub ExcelExtract()
Dim Item, Attachments, FolderName As Object
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim Folder As Outlook.MAPIFolder
Dim MailItem As Outlook.MailItem
Set myOlExp = myOlApp.ActiveExplorer
Set nsp = myOlApp.GetNamespace("MAPI")
Set Folder = nsp.GetDefaultFolder(olFolderInbox)
x = 0
itemcount = Folder.Items.Count
For Each myitem In Folder.Items
Set Attachments = myitem.Attachments
If InStr(myitem.Subject, "Workorder") > 0 And
myitem.Attachments.Count > 0 Then mycount = mycount + 1
Next
Workordercount = itemcount - mycount
Do Until Folder.Items.Count = Workordercount
For Each Item In Folder.Items
If InStr(Item.Subject, "Workorder") > 0 Then
Set Attachments = Item.Attachments
If Attachments.Count > 0 Then x = x + 1
For i = 1 To Attachments.Count
Attachments(i).SaveAsFile "C:\Worktemp\Workorder" & x &
".xls"
Item.Delete
Next i
End If
Next
Loop
End Sub
Thanks