Outlook VBA -auto export email with attachments to network folder as pdf

Yes, can be done in VBA, just need more details.

Are all the emails in the same single folder?

Do you want to process all emails, and send to different folders based on a defined mapping in the VBA, or just the emails that have the one subject you indicated?

Are all files going into the same single folder, and if so can there be duplicate names and how should they be handled.

---

»bp

Are all the emails in the same single folder?  Yes. Emails are being sent to the same email address so its the same single outlook folder.  

Yes we want to want to process all emails, and send to different folders based on a defined mapping in the VBA.

I need to explain a little more  to answer the last question.

All subject lines will include a 10 digit account number followed by customer last name then the category which determines the destination.

example
subject: 0000012345 Smith [Denied Sale]

The attachments for the above would theoretically end up in the 'Denied Sale' folder
I think we can have multiple attachments  saved within a folder when we define the path in VBA, right?

For example, if the above email had multiple attachments, then we could save them in a folder called "0000012345" within the 'Denied Sale' folder.

The documents we are sending over to folder will be accessed by imaging dept that will scan them for posterity. The account numbers are needed for indexing.

Thanks for your help .

Working this, making decent progress...

---

»bp

Okay, this seems to be working well in a basic test here.  You will need to add this in a module in Outlook there and adjust the two "paths" after the DIM statements.  The first will be the fully qualified path to the Outlook folder to process emails in, the other is the base folder where the extracted attachments will go.   Sub-folders will be created under this for the Category and Account (I decided to always create the Account folder and store in it, even if there was only one attachment, hope that's okay).

You will need to add a reference in the VBA editor to the scripting runtime so that the filesystem object is available, if you aren't familiar with that process it's described here.

' Require variables to be defined before usage
Option Explicit

Sub ExtractAttachments()
    ' Local variables
    Dim objFSO As FileSystemObject
    Dim strEmailFolderPath As String
    Dim objEmailFolderPath As Outlook.Folder
    Dim strAttachmentFolderPath As String
    Dim objItem As Object
    Dim objMailItem As Outlook.MailItem
    Dim objAttachment As Outlook.Attachment
    Dim strSubject As String
    Dim arrTemp1() As String
    Dim arrTemp2() As String
    Dim strAccount As String
    Dim strCustomer As String
    Dim strCategory As String
    Dim strSavePath As String
    
    ' Create filesystem object
    Set objFSO = New FileSystemObject
    
    ' Define email folder to process, and base folder for extracted attachments
    strEmailFolderPath = "\\Bills Folders\EE29136681"
    strAttachmentFolderPath = "B:\EE\EE29136681\Extract"
    
    ' Make sure email folder exists
    Set objEmailFolderPath = GetFolderPath(strEmailFolderPath)
    If objEmailFolderPath Is Nothing Then
        MsgBox "Email folder to process not found """ & strEmailFolderPath & """."
        Exit Sub
    End If
    
    ' Make sure extract destination folder exists
    strAttachmentFolderPath = objFSO.GetAbsolutePathName(strAttachmentFolderPath)
    If Not objFSO.FolderExists(strAttachmentFolderPath) Then
        MsgBox "Target folder for attachements not found """ & strAttachmentFolderPath & """."
        Exit Sub
    End If
    
    ' Loop through all items in this folder
    For Each objItem In objEmailFolderPath.Items
    
        ' Only process email items
        If objItem.Class = olMail Then
        
            ' Only process emails with attachments
            Set objMailItem = objItem
            If objMailItem.Attachments.Count > 0 Then
            
                ' Disect subject and extract needed text (skip if it doesn't conform)
                strSubject = objMailItem.Subject
                arrTemp1 = Split(strSubject, "[")
                If UBound(arrTemp1) = 1 Then
                    arrTemp2 = Split(Trim(arrTemp1(0)), " ")
                    If UBound(arrTemp2) = 1 Then
                        ' Save extracted subject terms
                        strAccount = arrTemp2(0)
                        strCustomer = arrTemp2(1)
                        strCategory = Replace(arrTemp1(1), "]", "")
                
                        ' Process each attachment to this email
                        For Each objAttachment In objMailItem.Attachments
                        
                            ' Skip embeded attachments
                            If objAttachment.Type <> 6 Then
                            
                                ' Build path to save attachment in, and create folders if they don't exist
                                strSavePath = strAttachmentFolderPath
                                strSavePath = strSavePath & "\" & strCategory
                                If Not objFSO.FolderExists(strSavePath) Then
                                    objFSO.CreateFolder strSavePath
                                End If
                                strSavePath = strSavePath & "\" & strAccount
                                If Not objFSO.FolderExists(strSavePath) Then
                                    objFSO.CreateFolder strSavePath
                                End If
                                strSavePath = strSavePath & "\" & objAttachment.FileName
                                
                                ' Save this attachment if it doesn't already exist
                                If Not objFSO.FileExists(strSavePath) Then
                                    objAttachment.SaveAsFile strSavePath
                                End If
                                
                            End If
                            
                        Next objAttachment
                        
                    End If
                    
                End If
                
            End If
            
        End If
        
    Next objItem
    
End Sub

Select allOpen in new window

---

»bp

thanks Bill,
I should have mentioned that the email messages themselves, with or without attachments, would require processing.

Well, you really should have included that in the question details you asked.

Please test what I provided and see if it delivers what you asked for.

If it does then come back and describe in detail what you forgot to include before.

If it's not a huge change we can include it here.  If it's a lot different and additional work then we will need another question for that.

---

»bp

my apologies to Bill. I did not ask the right question initially so I changed it.

maybe what I am trying to do is not possible?

I was waiting for feedback on step 1, based on my prior comment:

Please test what I provided and see if it delivers what you asked for.

---

»bp

alright. gave me an error at line
   Set objEmailFolderPath = GetFolderPath(strEmailFolderPath)

What was the value of strEmailFolderPath  when the error occurred?

---

»bp

strEmailFolderPath = "C:\Users\osandoval\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.Outlook\GOEJ5DLI"

Where did you come up with that?

It needs to be the logical folder path from Outlook to reference the Outlook folder you want to scan.  It should look like:

"\\foo@bar.com\Inbox"

Or similar, depending on how you have organized things in Outlook.  For example, if you right click on the folder in Outlook and select Properties you should see a popup window like below.  You need to concatenate (1) and (2) as highlighted below, placing a backslash between them.

---

»bp

that was my outlook windows folder. I corrected it to \\xxxxxxxxx@yyyyyyyyyyyyy.com\inbox.  still received 'sub or function' not defined' error on Getfolderpath

Edit: Removed actual email address for privacy reasons.

Ah, looks like I forgot to add that procedure in, it's in my Utils folder and I just take it for granted...

Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer
        
    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function
        
GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
End Function

Select allOpen in new window

---

»bp

I ran it. No  error message. But the file did not export .

Bill,
Your code seemed to run but nothing exported I think because Custom form script is disabled on this PC.  I am getting it enabled it and will retry.  Thanks for your help.

OK , with script enabled, it did not work.  I followed the instructions exactly as provided.

I would suggest debugging through it line by line, examining variables and following the logic to see what is working as expected, and hopefully where the problem lies.  It works here for me, but you may have some differences there that are throwing it off.

---

»bp

You can also use the commercial utility developed by my company: Export Messages to PDF. With it, you can create an Outlook rule that will run this utility on incoming messages and configure the utility as needed (file naming, attachments, etc.).

Reading the last post I was confused since this differed from what I thought the question asked.  In reviewing changes to the question after it was posted on 2/20/2019 I see the following changes:


That's a pretty significant change, and needless to say isn't what my solution does, since when I write it that wasn't the requirement.  Given that large change to the scope, the fact that my solution isn't working for the OP anyway, and this new porposed solution I'm going to step away from this question.  Good luck.

---

»bp

Bill Prew, I mentioned five days ago that I changed the question.  Then you insisted did I try your code before offering an updated solution.  Your code did not work and now instead of helping you step away from the question completely . thank you for wasting my time.

I guess there was some confusion here.  When you mentioned earlier:

my apologies to Bill. I did not ask the right question initially so I changed it.

I did not realize you had edited and rewritten the whole original question.  I honestly thought you were just following up on this prior comment that you had made.

I should have mentioned that the email messages themselves, with or without attachments, would require processing.

EE doesn't give users a clear indication that a posted question has had content changed so it's not easy to be aware of that.  Yes, now that I dug deeper into the original question modification history your comment indicating you changed the question makes more sense, I missed that.  Please try and understand one of the challenges contributors on this site face if changing requirements of a question as we propose solutions.  It often causes frustration on both sides of the question, asker and answerer.

As far as where this question stands for me at this point I'm happy to help with getting what I provided to work.  I've already made a suggestion for the approach to take there in this comment.

I would suggest debugging through it line by line, examining variables and following the logic to see what is working as expected, and hopefully where the problem lies.  It works here for me, but you may have some differences there that are throwing it off.

That's how I would go about it, but I can't do that here since in my simple test case it worked as expected.  So something is likely a little different there and debugging is how I would look for things that aren't working properly.

As far as the additional need to save the email itself as a PDF, that is harder than you might think.  Outlook doesn't provide that functionality so an external utility or program would have to be used.  One approach could be copying the email in Word and then using it's save to PDF capability.  Another could be using a utility like Adobe or others that has "save as PDF" type capability.  I don't have experience with either of those so am unable to help you on that part of the question.

---

»bp