So first of all, I have Windows 11 and my version of Microsoft Outlook is 2010.
I am the accounts payable clerk for my company. I recently went paperless and am trying to find some shortcuts to organizing my incoming invoices which are emailed to me in pdf. I then save the pdf’s to a folder for sorting & processing later.
I spend much of my time, saving each individual file, then later I moved them to subfolders, A, B, C…etc.
I know how to save all attachments in a single email.
And I know how to use VBA (sorta) to select many emails and run a macro in outlook to save every attachment in those selected emails to my folder. But then I still have to sort them into sub folders. I’m trying to find a way to sort my emails in my inbox by company, so I can first sort, then select only the companies that start with A, run my script, then move all the attachments to the A folder all at once. Actually I would love to find a way to set it up so that I can run a script that will send attachments to a specific folder from a specific email. For example… attachments from “this email” save to “this folder”.
I usually download my invoices weekly so i have hundreds. So far the best I can do is save them all at once, but then i still have to open each one to sort them. Some I can tell by the file name what it is, not not all.
And its not easy to sort the emails first, some emails will have a person name, some will have the company, some will say ‘noreply..etc’.
here is the script that lets me select many many emails and save all attachments below. Is it possible to edit this somehow? Can i run a script or a rule where i can select a hundred emails at once, and all the invoices from certain vendors go to that vendor folder? OR, how can I edit/format incoming emails so i can sort alphbetically and then download letter by letter? I’ve thought about doing rules with catagories, but then I still have to run the script a letter at a time. I would love some ideas. And appreciate any feedback! I get maybe 2-3 hundred emails a week, some emails have one attachment, some have many, but there are a few vendors I get many invoices regularly. thank you!
Dim GCount As Integer
Dim GFilepath As String
Public Sub SaveAttachments()
‘Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
On Error Resume Next
xFolderPath = CreateObject(“WScript.Shell”).SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & “Attachments”
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
VBA.MkDir xFolderPath
End If
GFilepath = “”
For Each xMailItem In xSelection
Set xAttachments = xMailItem.Attachments
xAttCount = xAttachments.Count
xSaveFiles = “”
If xAttCount > 0 Then
For i = xAttCount To 1 Step -1
GCount = 0
xFilePath = xFolderPath & xAttachments.Item(i).FileName
GFilepath = xFilePath
xFilePath = FileRename(xFilePath)
If IsEmbeddedAttachment(xAttachments.Item(i)) = False Then
xAttachments.Item(i).SaveAsFile xFilePath
If xMailItem.BodyFormat <> olFormatHTML Then
xSaveFiles = xSaveFiles & vbCrLf & “<Error! Hyperlink reference not valid.>”
Else
xSaveFiles = xSaveFiles & “
” & “” & xFilePath & “”
End If
End If
Next i
End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub
Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As FileSystemObject
On Error Resume Next
Set xFso = CreateObject(“Scripting.FileSystemObject”)
xPath = FilePath
FileRename = xPath
If xFso.FileExists(xPath) Then
GCount = GCount + 1
xPath = xFso.GetParentFolderName(GFilepath) & “” & xFso.GetBaseName(GFilepath) & ” ” & GCount & “.” + xFso.GetExtensionName(GFilepath)
FileRename = FileRename(xPath)
End If
xFso = Nothing
End Function
Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = “”
xCid = Attach.PropertyAccessor.GetProperty(“http://schemas.microsoft.com/mapi/proptag/0x3712001F”)
If xCid <> “” Then
xHtml = xItem.HTMLBody
xID = “cid:” & xCid
If InStr(xHtml, xID) > 0 Then
IsEmbeddedAttachment = True
End If
End If
End Function
