none
Email File RRS feed

  • Question

  • Is it possible to have a macro that will read all the files on a particularfolder and then if the file is names for example:

    Invoice80943ClientXYZ_peter@contoso.com.pdf

    It will generate an email subject Invoice 80943
    Recipient: peter@contoso.com

    and it will attach the file Invoice80943ClientXYZ_peter@contoso.com.pdf to the email and send it?

    after the file is sent the file should be deleted.


    Tuesday, August 26, 2014 4:01 PM

Answers

  • Absolutely possible. I wrote code (with substantial help from the experts in these forums) to create PDF reports and email them (then archive) on a monthly basis.

    Things you didn't include in your post : what version of Excel are you using, and what email program and version? There are some minor 'gotchas', like if you are using Outlook 365 there is a limit on how many drafts you can have open at a time (.display) so you have to either process smaller batches of files, or just go ahead and send the files without review (we have to review before sending, so we do small batches)

    Here is one I've used in Excel2010/Outlook2010. I quickly removed some of our proprietary stuff, and added in the code to pull apart your filename and use it, so treat this as aircode- it may take some tweaking.

    Sub EMail_Reports_Sample_Code()

        'For the email side
        Dim OutApp As Object
        Dim OutMail As Object
        Dim sh As Worksheet
        Dim cell As Range, FileCell As Range, rng As Range
        Dim TargetPath As String

        Application.EnableEvents = False
        Set OutApp = CreateObject("Outlook.Application")

        'for the filesearch side
        Dim objFSO As Object
        Dim objFolder As Object
        Dim objFile As Object
        Dim objFile2 As Object
        Dim ws As Worksheet
       
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Dim filestr As String
       
        'Get the folder object associated with the directory
            '-------------------------------------------------------
            'Code just to get path, if it hasn't already been specified
            If Len(TargetPath) < 1 Then TargetPath = GetFolder(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\desktop")
            '-------------------------------------------------------
       
        If Len(TargetPath) < 1 Then
            MsgBox "No target directory selected; auto-email process aborted.", , "Path Not Found"
            GoTo CleanUp
        Else
       
        Set objFolder = objFSO.GetFolder(TargetPath)
       
        On Error Resume Next
        MkDir TargetPath & "\Sent Reports"
        On Error GoTo 0
       
        For MassiveNumber = 1 To 500 '500= more reports than I will ever have in this process, you may need more
                                    'or convert this to a while loop, if you prefer
       
           
            AttachmentCount = 0
            CurrFileCount = objFolder.Files.Count
            If CurrFileCount <= 0 Then GoTo CleanUp 'no user error msg, because this isn't an error - just out of files
           
       
                'Loop through the Files collection for AMs
                 For Each objFile In objFolder.Files
                     StrEmailSubject = "Invoice " & Mid(objFile.Name, 8, 5) 'this assumes all invoices are 5-digit!!
                     FindUnderscore = InStr(objFile.Name, "_")
                     StrEmailAddress = Right(objFile.Name, Len(objFile.Name) - FindUnderscore)
                           
                    Set OutMail = OutApp.CreateItem(0)
                    With OutMail
                        .Subject = StrEmailSubject
                        .Body = "This is the salutation and text of your email. " & _
                                "" & _
                        Chr(13) & Chr(13) & _
                        "paragraph 1: you can include whatever text you want. " & _
                        Chr(13) & Chr(13) & _
                        "Paragraph 2" & _
                         Chr(13) & Chr(13) & _
                        "Closing/Thank you. "
                        .Attachments.Add (TargetPath & "\" & objFile.Name)
                        .To = StrEmailAddress
                       
                        'set read receipt
                        .ReadReceiptRequested = True
                        'set delivery receipt
                        .OriginatorDeliveryReportRequested = True
                       
                        'OutMail.Send  'Or use Display
                        OutMail.Display
                       
                        Set OutMail = Nothing
                               
                        DoEvents
                        'archive the file
                        Name (TargetPath & "\" & objFile.Name) As (TargetPath & "\Sent\" & objFile.Name)
                       
                    End With
                Next
            End If
        Next MassiveNumber

    End If

    CleanUp:
        Set OutApp = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With

        Set objFolder = Nothing
        Set objFile = Nothing
        Set objFSO = Nothing

    End Sub

    Tuesday, August 26, 2014 5:20 PM
  • Sorry about that. Add this as another sub:

    Function GetFolder(strPath As String) As String
        Dim fldr As FileDialog
        Dim sItem As String
        Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
        With fldr
            .Title = "Select a Folder"
            .AllowMultiSelect = False
            .InitialFileName = strPath
            If .Show <> -1 Then GoTo NextCode
            sItem = .SelectedItems(1)
        End With
    NextCode:
        GetFolder = sItem
        Set fldr = Nothing
    End Function

    Tuesday, August 26, 2014 7:54 PM
  • One other thought- the aircode I provided assumes that your invoice is always 5 numbers, and also assumes that the underscore char "_" will only occur right before the email address. If you have any client names with underscore in the name itself, you will either fail to email the invoice, or you will email it to the wrong email address. E.g.:

    Invoice80943Team_Alpha_peter@contoso.com.pdf

    would get sent to *Alpha*_peter@contoso.com.pdf instead of peter@contoso.com.pdf

    And in copying this, I just realized that the code I provided is incomplete- you will also need to strip off the last 4 characters (".pdf") to get the email address, so add this new line (first line provided to show you what line to add it after):

    StrEmailAddress = Right(objFile.Name, Len(objFile.Name) - FindUnderscore) '<- keep this

    StrEmailAddress = left(StrEmailAddress, Len(StrEmailAddress)-4) '<- add this





    Tuesday, August 26, 2014 8:17 PM
  • So changing from

    Invoice80943ClientXYZ_peter@contoso.com.pdf  to INV011030peter@contoso.com.pdf

    Change:

         StrEmailSubject = "Invoice " & Mid(objFile.Name, 8, 5) 'this assumes all invoices are 5-digit!!

    to

         StrEmailSubject = "Invoice " & Mid(objFile.Name, 4, 6) '6 digit invoice starting with 4th char of filename

    and change

         FindUnderscore = InStr(objFile.Name, "_")
         StrEmailAddress = Right(objFile.Name, Len(objFile.Name) - FindUnderscore)

         StrEmailAddress = left(StrEmailAddress, Len(StrEmailAddress)-4)

    to

         StrEmailAddress = Right(objFile.Name,len(objFile.Name)-9)

         StrEmailAddress = left(StrEmailAddress, Len(StrEmailAddress)-4)

    Wednesday, August 27, 2014 3:12 PM

All replies

  • Absolutely possible. I wrote code (with substantial help from the experts in these forums) to create PDF reports and email them (then archive) on a monthly basis.

    Things you didn't include in your post : what version of Excel are you using, and what email program and version? There are some minor 'gotchas', like if you are using Outlook 365 there is a limit on how many drafts you can have open at a time (.display) so you have to either process smaller batches of files, or just go ahead and send the files without review (we have to review before sending, so we do small batches)

    Here is one I've used in Excel2010/Outlook2010. I quickly removed some of our proprietary stuff, and added in the code to pull apart your filename and use it, so treat this as aircode- it may take some tweaking.

    Sub EMail_Reports_Sample_Code()

        'For the email side
        Dim OutApp As Object
        Dim OutMail As Object
        Dim sh As Worksheet
        Dim cell As Range, FileCell As Range, rng As Range
        Dim TargetPath As String

        Application.EnableEvents = False
        Set OutApp = CreateObject("Outlook.Application")

        'for the filesearch side
        Dim objFSO As Object
        Dim objFolder As Object
        Dim objFile As Object
        Dim objFile2 As Object
        Dim ws As Worksheet
       
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Dim filestr As String
       
        'Get the folder object associated with the directory
            '-------------------------------------------------------
            'Code just to get path, if it hasn't already been specified
            If Len(TargetPath) < 1 Then TargetPath = GetFolder(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\desktop")
            '-------------------------------------------------------
       
        If Len(TargetPath) < 1 Then
            MsgBox "No target directory selected; auto-email process aborted.", , "Path Not Found"
            GoTo CleanUp
        Else
       
        Set objFolder = objFSO.GetFolder(TargetPath)
       
        On Error Resume Next
        MkDir TargetPath & "\Sent Reports"
        On Error GoTo 0
       
        For MassiveNumber = 1 To 500 '500= more reports than I will ever have in this process, you may need more
                                    'or convert this to a while loop, if you prefer
       
           
            AttachmentCount = 0
            CurrFileCount = objFolder.Files.Count
            If CurrFileCount <= 0 Then GoTo CleanUp 'no user error msg, because this isn't an error - just out of files
           
       
                'Loop through the Files collection for AMs
                 For Each objFile In objFolder.Files
                     StrEmailSubject = "Invoice " & Mid(objFile.Name, 8, 5) 'this assumes all invoices are 5-digit!!
                     FindUnderscore = InStr(objFile.Name, "_")
                     StrEmailAddress = Right(objFile.Name, Len(objFile.Name) - FindUnderscore)
                           
                    Set OutMail = OutApp.CreateItem(0)
                    With OutMail
                        .Subject = StrEmailSubject
                        .Body = "This is the salutation and text of your email. " & _
                                "" & _
                        Chr(13) & Chr(13) & _
                        "paragraph 1: you can include whatever text you want. " & _
                        Chr(13) & Chr(13) & _
                        "Paragraph 2" & _
                         Chr(13) & Chr(13) & _
                        "Closing/Thank you. "
                        .Attachments.Add (TargetPath & "\" & objFile.Name)
                        .To = StrEmailAddress
                       
                        'set read receipt
                        .ReadReceiptRequested = True
                        'set delivery receipt
                        .OriginatorDeliveryReportRequested = True
                       
                        'OutMail.Send  'Or use Display
                        OutMail.Display
                       
                        Set OutMail = Nothing
                               
                        DoEvents
                        'archive the file
                        Name (TargetPath & "\" & objFile.Name) As (TargetPath & "\Sent\" & objFile.Name)
                       
                    End With
                Next
            End If
        Next MassiveNumber

    End If

    CleanUp:
        Set OutApp = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With

        Set objFolder = Nothing
        Set objFile = Nothing
        Set objFSO = Nothing

    End Sub

    Tuesday, August 26, 2014 5:20 PM
  • Thanks I'm using Outlook and Excel 2010

    I tried the code onto a module on excel, but the error I get is:

    Sub of Function not defined at this line:

    If Len(TargetPath) < 1 Then TargetPath = GetFolder(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\desktop")

    Tuesday, August 26, 2014 5:53 PM
  • Sorry about that. Add this as another sub:

    Function GetFolder(strPath As String) As String
        Dim fldr As FileDialog
        Dim sItem As String
        Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
        With fldr
            .Title = "Select a Folder"
            .AllowMultiSelect = False
            .InitialFileName = strPath
            If .Show <> -1 Then GoTo NextCode
            sItem = .SelectedItems(1)
        End With
    NextCode:
        GetFolder = sItem
        Set fldr = Nothing
    End Function

    Tuesday, August 26, 2014 7:54 PM
  • Hello Huan Pablo,

    The Getting Started with VBA in Outlook 2010 article in MSDN explain basics for developing such things. I think you will find it helpful.

    Tuesday, August 26, 2014 8:02 PM
  • One other thought- the aircode I provided assumes that your invoice is always 5 numbers, and also assumes that the underscore char "_" will only occur right before the email address. If you have any client names with underscore in the name itself, you will either fail to email the invoice, or you will email it to the wrong email address. E.g.:

    Invoice80943Team_Alpha_peter@contoso.com.pdf

    would get sent to *Alpha*_peter@contoso.com.pdf instead of peter@contoso.com.pdf

    And in copying this, I just realized that the code I provided is incomplete- you will also need to strip off the last 4 characters (".pdf") to get the email address, so add this new line (first line provided to show you what line to add it after):

    StrEmailAddress = Right(objFile.Name, Len(objFile.Name) - FindUnderscore) '<- keep this

    StrEmailAddress = left(StrEmailAddress, Len(StrEmailAddress)-4) '<- add this





    Tuesday, August 26, 2014 8:17 PM
  • Thank you so much, it works amazing.

    Ok managed to make it work, unbelievable solution thank you so much!


    Tuesday, August 26, 2014 10:56 PM
  • Do you think is possible to modify for INV011030peter@contoso.com.pdf

    that way I remove the possibility of the _ problem and also that is the length of the invoice that is 6 digits

    Tuesday, August 26, 2014 11:26 PM
  • So changing from

    Invoice80943ClientXYZ_peter@contoso.com.pdf  to INV011030peter@contoso.com.pdf

    Change:

         StrEmailSubject = "Invoice " & Mid(objFile.Name, 8, 5) 'this assumes all invoices are 5-digit!!

    to

         StrEmailSubject = "Invoice " & Mid(objFile.Name, 4, 6) '6 digit invoice starting with 4th char of filename

    and change

         FindUnderscore = InStr(objFile.Name, "_")
         StrEmailAddress = Right(objFile.Name, Len(objFile.Name) - FindUnderscore)

         StrEmailAddress = left(StrEmailAddress, Len(StrEmailAddress)-4)

    to

         StrEmailAddress = Right(objFile.Name,len(objFile.Name)-9)

         StrEmailAddress = left(StrEmailAddress, Len(StrEmailAddress)-4)

    Wednesday, August 27, 2014 3:12 PM
  • thank you!!!!
    Wednesday, August 27, 2014 3:54 PM
  • One last thing, I don't want to abuse from your great disposition to help, but If I want to take the whole email out of the file name, so that the attached file looks like

    INV008102.pdf

    Wednesday, August 27, 2014 3:56 PM
  • based on format: INV011030peter@contoso.com.pdf

    NewName = left(objFile.Name,9) & ".pdf"

    This assumes that you will only have pdf files in your directory. Otherwise you may cause some confusion, as you'd be creating a name that doesn't correspond with a real pdf file.

    I guess one option would be to check each filename early in the loop and verify that the last three digits are actually "pdf"

    Wednesday, August 27, 2014 11:01 PM
  • yes, where do I Put that Line?
    Wednesday, August 27, 2014 11:11 PM
  • I only have pdf docs on the folder, but the line I tried, I cant make it work.
    Friday, August 29, 2014 12:02 AM
  • Ah, sorry for the confusion. I took your last question as asking how to pull that string, but on rereading I'm guessing you want that to be the "new" filename, e.g.

    ...\folder\INV011030peter@contoso.com.pdf  becomes ...\folder\sent\INV011030.pdf

    when the file is emailed

    If that is correct, change:

                        'archive the file
                        Name (TargetPath & "\" & objFile.Name) As (TargetPath & "\Sent\" & objFile.Name)

    to

                        'archive the file

                        NewName = left(objFile.Name,9) & ".pdf"

                        Name (TargetPath & "\" & objFile.Name) As (TargetPath & "\Sent\" & NewName)


    Friday, August 29, 2014 4:43 PM
  • The problem is that the email has an invoice attached with this name:

    INV011030peter@contoso.com.pdf 

    and I want inside the email the name of the file as:

    INV011030.pdf 

    Friday, August 29, 2014 10:07 PM
  • Don't worry I found a way and it works, thanks again.

    I edited to this works perfect

    For Each objFile In objFolder.Files
                    StrEmailSubject = "Advanced Nutrients Invoice " & Mid(objFile.Name, 4, 6) '6 digit invoice starting with 4th char of filename
                     StrEmailAddress = Right(objFile.Name, Len(objFile.Name) - 9)
                     StrEmailAddress = Left(StrEmailAddress, Len(StrEmailAddress) - 4)
                     NewName = Left(objFile.Name, 9) & ".pdf"
                     Name (TargetPath & "\" & objFile.Name) As (TargetPath & "\Sent\" & NewName)
                     Set OutMail = OutApp.CreateItem(0)
                     With OutMail
                         .Subject = StrEmailSubject
                         .Body = "This is the salutation and text of your email. " & _
                                 "" & _
                         Chr(13) & Chr(13) & _
                         "paragraph 1: you can include whatever text you want. " & _
                         Chr(13) & Chr(13) & _
                         "Paragraph 2" & _
                          Chr(13) & Chr(13) & _
                         "Closing/Thank you. "
                         .Attachments.Add (TargetPath & "\Sent\" & NewName)
                         .To = StrEmailAddress

    Friday, August 29, 2014 10:46 PM
  • I have a challenge now.

    I need to use this format: INV013323juan_contoso-com.pdf

    So the @ cant be used, so I replaced it for a _ so I need to have the _ replaced for @ on the script and the -com needs to be replaced to a .com

    any ideas on how to do it?

    thank you!

    Thursday, October 16, 2014 6:10 PM