Sub Freshtomm()
Dim olFolder As Outlook.MAPIFolder
Dim att As Outlook.Attachment
Dim strFilePath As String
Dim fsSaveFolder As String
fsSaveFolder = "C:\test\" 'Change your folder path
strFilePath = "C:\temp\"
Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each msg In olFolder.Items
While msg.Attachments.Count > 0
bflag = False
If Right$(msg.Attachments(1).Filename, 3) = "msg" Then
bflag = True
msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg
Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg)
End If
sSavePathFS = fsSaveFolder & msg2.Attachments(1).Filename
End If
End Sub
Thank you very much, it works really well. And what if i wanted to save attachments only from e-mails recieved that day? Is it possible?Hello
.Code:Sub Freshtomm() Dim olFolder As Outlook.MAPIFolder Dim att As Outlook.Attachment Dim strFilePath As String Dim fsSaveFolder As String fsSaveFolder = "C:\test\" 'Change your folder path strFilePath = "C:\temp\" Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) For Each msg In olFolder.Items While msg.Attachments.Count > 0 bflag = False If Right$(msg.Attachments(1).Filename, 3) = "msg" Then bflag = True msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg) End If sSavePathFS = fsSaveFolder & msg2.Attachments(1).Filename End If End Sub
Try this...Hope you like it.
I tried to run that macro at my work, and it says "Compile error: User-defined type not defined" with marked first line of the code. Do you know why is that?
To my second question - I am getting emails with attachmens every day, and i want to save attachments only from emails received today. Is it possible?
Thanks.
T.