Outlook 2010 Macro

[John]

Hello All,

I am working on a Macro for Outlook 2010 that will save and stripe
attachments from my emails.

I found this code on the internet and it works great, except I want to
be able to append the date and time to the end of the file name when
it saves to my computer.

I am not sure where or what to put in here to make it do that.

Any help is greatly appreciated.

--------------------CODE----------------------
Sub SaveAttachment()
'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", "\\winp-
oa-103\FldrRedir_3$\A239185\Data\00 - Reimbursement\00 - Outlook
Attachments\")
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
'add remark to message text
myItem.Body = myItem.Body & vbCrLf & _
"Removed Attachments:" & vbCrLf

'for all attachments do...
For i = 1 To myAttachments.Count
'save them to destination
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName
'add name and destination to message text
myItem.Body = myItem.Body & _
"File: " & myOrt & _
myAttachments(i).DisplayName & vbCrLf
Next i

'for all attachments do...
While myAttachments.Count > 0
'remove it (use this method in Outlook XP)
'myAttachments.Remove 1
'remove it (use this method in Outlook 2000)
myAttachments(1).Delete

Wend
'save item without attachments
myItem.Save

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
------------------------END CODE---------------

 

[Char Jackson]

Hello All,

I am working on a Macro for Outlook 2010 that will save and stripe
attachments from my emails.

I found this code on the internet and it works great, except I want to
be able to append the date and time to the end of the file name when
it saves to my computer.

I am not sure where or what to put in here to make it do that.

Any help is greatly appreciated.

It looks like the relevant code block is this one:

'for all attachments do...
For i = 1 To myAttachments.Count
'save them to destination
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName
'add name and destination to message text
myItem.Body = myItem.Body & _
"File: " & myOrt & _
myAttachments(i).DisplayName & vbCrLf
Next i

And the relevant line to modify is this one:

myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName

It looks like it's basically doing a Save As, where myOrt is the path,
DisplayName is the name of the attachment, and those would be appended
with the current date and time. Sorry, I don't have the syntax handy.

I haven't tested this, so I could be way off.