S
Steph
Hello all. I have a procedure that copies excel attachments from an
Outloook folder and pastes them to a predefined drive and folder.
Unfortunately, it only works if each file has a different name (I think if
they are the same name, it overwrites the original). Of course, I have
timesheets coming in via e-mail that all have the same file name. Is there
a way to add a counter to the end of each name so all the files are copied
in? Thanks!
Here's the code I have:
Sub SaveAtt()
'Saves attachments to a specified folder
Dim ol As Outlook.Application
Dim ns As NameSpace
Dim Fldr As MAPIFolder
Dim Mi As MailItem
Dim Att As Attachment
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set Fldr = ns.Folders("Public Folders").Folders("All Public
Folders").Folders("Timesheet")
For Each Mi In Fldr.Items
If Mi.Attachments.Count > 0 Then
For Each Att In Mi.Attachments
Att.SaveAsFile "H:\Timesheet Data\" & Att.Filename
Next Att
End If
Next Mi
Set Att = Nothing
Set Mi = Nothing
Set Fldr = Nothing
Set ns = Nothing
Set ol = Nothing
End Sub
Outloook folder and pastes them to a predefined drive and folder.
Unfortunately, it only works if each file has a different name (I think if
they are the same name, it overwrites the original). Of course, I have
timesheets coming in via e-mail that all have the same file name. Is there
a way to add a counter to the end of each name so all the files are copied
in? Thanks!
Here's the code I have:
Sub SaveAtt()
'Saves attachments to a specified folder
Dim ol As Outlook.Application
Dim ns As NameSpace
Dim Fldr As MAPIFolder
Dim Mi As MailItem
Dim Att As Attachment
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set Fldr = ns.Folders("Public Folders").Folders("All Public
Folders").Folders("Timesheet")
For Each Mi In Fldr.Items
If Mi.Attachments.Count > 0 Then
For Each Att In Mi.Attachments
Att.SaveAsFile "H:\Timesheet Data\" & Att.Filename
Next Att
End If
Next Mi
Set Att = Nothing
Set Mi = Nothing
Set Fldr = Nothing
Set ns = Nothing
Set ol = Nothing
End Sub