Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
Groups keyboard shortcuts have been updated
Dismiss
See shortcuts

Save attachments with incrementing filename

39 views
Skip to first unread message

evets....@gmail.com

unread,
May 31, 2017, 11:56:01 AM5/31/17
to
I have slightly adapted the code below - which I discovered online. I need the macro to check if the filename exists and if it does to place an incrementing number at the end of the filename.

I'm thinking I'll need to use an "If Filexist" statement coupled with " x = x + 1 but can't see where/how to do this.

Would someone help please?

Steve



Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String ' Get the path to your My Documents folder
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
On Error Resume Next
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
' Set the Attachment folder.
' the attachments folder hard-coded in as it does not correspond to the user's defaul Documents folder.
strFolderpath = "C:\Users\Costa\ECO2t\Pending Jobs_Surveys\"


'MsgBox strFolderpath
' Check each selected item for attachments.
' If attachments exist, save them to the Temp
' folder and strip them from the item.
For Each objMsg In objSelection
' This code only strips attachments from mail items.
' If objMsg.class=olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
'MsgBox objAttachments.Count
If lngCount > 0 Then
' We need to use a count down loop for
' removing items from a collection. Otherwise,
' the loop counter gets confused and only every
' other item is removed.
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
strFile = objAttachments.Item(i).FileName

If Len(Dir(strFolderpath & objMsg.Subject, vbDirectory)) = 0 Then
MkDir strFolderpath & objMsg.Subject
End If

' Combine with the path to the folder.
strFile = strFolderpath & objMsg.Subject & "\" & strFile
' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile
' Delete the attachment.
objAttachments.Item(i).Delete
'write the save as path to a string to add to the message
'check for html and use html tags in link
If objMsg.BodyFormat <> olFormatHTML Then
strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
Else
strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
strFile & "'>" & strFile & "</a>"
End If
'MsgBox strDeletedFiles
Next i
' End If
' Adds the filename string to the message body and save it
' Check for HTML body
If objMsg.BodyFormat <> olFormatHTML Then
objMsg.Body = objMsg.Body & vbCrLf & _
"The file(s) were saved to " & strDeletedFiles
Else
objMsg.HTMLBody = objMsg.HTMLBody & "<p>" & _
"The file(s) were saved to " & strDeletedFiles
End If
objMsg.Save
End If
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub ' SaveAttachments

depressed

unread,
Jun 3, 2017, 8:08:33 AM6/3/17
to
On Wed, 31 May 2017 08:56:01 -0700 (PDT), evets....@gmail.com
wrote:
I have made a similar macro at work for saving attachments but since
I am home I will gve you a thought from memory.

Look at the VBA FileSystemObject in Outlook help

Set fs = CreateObject("Scripting.FileSystemObject")

once you create an object out of the filesystem, you can then use the
FileExists method to test your proposed attachment file name before
you save it. if the file exists then you increment and test again

it appears that "strFile" is your proposed path and filename. Try
this:

x=1
do until fs.FileExists(strFile)=false
x=x+1
strfile=strfile & str(x)
loop
objAttachments.Item(i).SaveAsFile strFile


if the FALSE condition exists this ought to drop thru the loop and
allow you to save the file with the first choice of filename and if
that already exists (TRUE) then the increment occurs and tests again.

once the fileexists is FALSE then you can use that filename with
impunity.

There is also a folderexists method you can use to precheck the
existence of a directory, although fileexists can handle full file
names and paths.

quick and dirty
hope it helps.

depressed
0 new messages