G
Guest
Hi There
I am using this code (which I got from here) to try to save email
attachments to a folder. At the moment it saves the file as the name of the
person sending it, which is what I want. However, if the same person was to
send two, the second would overwrite the first. Ideally I'd like the date
and time but someone suggested using & now() but this doesn't work as excel
doesn't like the file path.
Has anyone got any ideas?
HAs anyone got
Sub SaveAttachments()
Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim MoveToFldr As MAPIFolder
Dim olMi As MailItem
Dim olAtt As Attachment
Dim MyPath As String
Dim i As Long
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set MoveToFldr = Fldr.Folders("eisreq")
MyPath = "I:\EIS\Forms\"
For i = Fldr.Items.Count To 1 Step -1
Set olMi = Fldr.Items(i)
If InStr(1, olMi.Subject, "EIS") > 0 Then
For Each olAtt In olMi.Attachments
If olAtt.Filename = "EIS Request.xls" Then
olAtt.SaveAsFile MyPath & olMi.SenderName &now() & ".xls"
End If
Next olAtt
olMi.Save
olMi.Move MoveToFldr
End If
Next i
Set olAtt = Nothing
Set olMi = Nothing
Set Fldr = Nothing
Set MoveToFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
Any help would be really appreciated
Thanks in advance
Jamie
I am using this code (which I got from here) to try to save email
attachments to a folder. At the moment it saves the file as the name of the
person sending it, which is what I want. However, if the same person was to
send two, the second would overwrite the first. Ideally I'd like the date
and time but someone suggested using & now() but this doesn't work as excel
doesn't like the file path.
Has anyone got any ideas?
HAs anyone got
Sub SaveAttachments()
Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim MoveToFldr As MAPIFolder
Dim olMi As MailItem
Dim olAtt As Attachment
Dim MyPath As String
Dim i As Long
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set MoveToFldr = Fldr.Folders("eisreq")
MyPath = "I:\EIS\Forms\"
For i = Fldr.Items.Count To 1 Step -1
Set olMi = Fldr.Items(i)
If InStr(1, olMi.Subject, "EIS") > 0 Then
For Each olAtt In olMi.Attachments
If olAtt.Filename = "EIS Request.xls" Then
olAtt.SaveAsFile MyPath & olMi.SenderName &now() & ".xls"
End If
Next olAtt
olMi.Save
olMi.Move MoveToFldr
End If
Next i
Set olAtt = Nothing
Set olMi = Nothing
Set Fldr = Nothing
Set MoveToFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
Any help would be really appreciated
Thanks in advance
Jamie