A
adimax
Here's what I am looking to do:
We have users that get multiple emails per day, from the same source,
always with an attachement. I'm looking to automate the open/save as/
save of the attached files, and have the file names stored in an Excel
spreadsheet. The users will update the sheet throughout the day, each
cell from A1 going down (A2, A3, etc) will have the next attachements
filename. This could also be done in a .txt file, but I'd prefer to
use Excel.
Anyway, here's my code so far (found/modified off a link from this
group):
Sub SaveAttachments()
'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
'Ask for destination folder
myOrt = InputBox("Destination", "Save Attachments", "W:\test\")
On Error Resume Next
'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'for all items do...
For Each myItem In myOlSel
'point on attachments
Set myAttachments = myItem.Attachments
'if there are some...
If myAttachments.Count > 0 Then
'for all attachments do...
For i = 1 To myAttachments.Count
'save them to destination
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName
Next i
End If
Next
'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub
I'm assuming the section:
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName
is where I want it to point at a spreadsheet prior to the save for the
filname, but I'm stuck on how to get it to do that and cycle down the
cells for the next name.
Any advice or support is as always, greatly appreciated.
We have users that get multiple emails per day, from the same source,
always with an attachement. I'm looking to automate the open/save as/
save of the attached files, and have the file names stored in an Excel
spreadsheet. The users will update the sheet throughout the day, each
cell from A1 going down (A2, A3, etc) will have the next attachements
filename. This could also be done in a .txt file, but I'd prefer to
use Excel.
Anyway, here's my code so far (found/modified off a link from this
group):
Sub SaveAttachments()
'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
'Ask for destination folder
myOrt = InputBox("Destination", "Save Attachments", "W:\test\")
On Error Resume Next
'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'for all items do...
For Each myItem In myOlSel
'point on attachments
Set myAttachments = myItem.Attachments
'if there are some...
If myAttachments.Count > 0 Then
'for all attachments do...
For i = 1 To myAttachments.Count
'save them to destination
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName
Next i
End If
Next
'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub
I'm assuming the section:
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName
is where I want it to point at a spreadsheet prior to the save for the
filname, but I'm stuck on how to get it to do that and cycle down the
cells for the next name.
Any advice or support is as always, greatly appreciated.