VBA issue: file not attaching in email

**jw01** · 08-05-2024, 03:18 PM

Hi

I have my code, where it saves a file based on username, in a specific folder, and then creates an email and attaches the filtered version of the file so i can send the email out.

this is my original macro:

Sub mailer()

    Dim ws_list As Worksheet
    Dim ws_mail As Worksheet
    Dim ws As Worksheet
    Dim i As Long
    Dim lr As Long
    Dim lr2 As Long
    Dim fname As String
    Dim newbook As Workbook
    Dim my_message As String

    fname = "C:\Users\john.smith\xx\Desktop\FP&A\Allocations\Test\Consolidated IES.xlsx"

    my_message = "<!DOCTYPE html>" & _
                 "<html>" & _
                 "<head>" & _
                 "<style>" & _
                 "body { font-family: 'Aptos', sans-serif; font-size: 10pt; }" & _
                 "</style>" & _
                 "</head>" & _
                 "<body>" & _
                 "<p>Hi [person],</p>" & _
                 "<p>Hope you are well.</p>" & _
                 "<p>I am reaching out to gain a better understanding of how our XX system XX XX xx and handles the charge-out of XX for xx. Specifically, I would like to discuss the following points:</p>" & _
                 "<ul>" & _
                 "<li>The process for xx rates by XX and product lines.</li>" & _
                 "<li>How the percentage XX are determined and assigned.</li>" & _
                 "<li>Any key considerations or methodologies used in this XX  XX.</li>" & _
                 "</ul>" & _
                 "<p>In the attached workbook, if you can kindly assign the % the respective xx will be working in the corresponding xx(columns W:Z).</p>" & _
                 "<p>For context, I am currently working with XX from the XX Division, and this inquiry is specifically focused on the xx of xx within the XX xx. As part of our ongoing efforts to realign our XX , it is crucial that we fully understand the mechanics behind these allocations. Your expertise and insights would be greatly appreciated.</p>" & _
                 "<p>Could we schedule a meeting at your earliest convenience to discuss this in detail? I am looking forward to your response and am available for a meeting at a time that works best for you.</p>" & _
                 "<p>Thank you so much for your cooperation.</p>" & _
                 "</body>" & _
                 "</html>"

    Set ws_list = ThisWorkbook.Worksheets("Email list")
    lr = ws_list.Range("D" & Rows.Count).End(xlUp).Row
    If lr < 11 Then Exit Sub 'there are no emails listed
    For i = 11 To lr
        With ThisWorkbook
            .Sheets("Summary").Copy after:=.Sheets("Summary")
            Set ws_mail = .Sheets(.Sheets("Summary").Index + 1)
        End With
        'convert columns C:T to values (if not already)
        lr2 = ws_mail.Range("D" & Rows.Count).End(xlUp).Row
        ws_mail.Range("C11:T" & lr2).Value = ws_mail.Range("C11:T" & lr2).Value
        'turn off filter:
        ws_mail.AutoFilterMode = False
        'filter by column N
        ws_mail.Range("C10:BD" & lr2).AutoFilter field:=12, Criteria1:="<>*" & ws_list.Range("C" & i).Value & "*"
        On Error Resume Next
        ws_mail.Range("N11:N" & lr2).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        On Error GoTo 0
        ws_mail.AutoFilterMode = False
        If ws_mail.Range("N11").Value = vbNullString Then GoTo end_loop 'no data for this user
        lr2 = ws_mail.Range("D" & Rows.Count).End(xlUp).Row
        ws_mail.Range("C10:BD" & lr2).AutoFilter field:=10, Criteria1:="<>Y"
        On Error Resume Next
        ws_mail.Range("L11:L" & lr2).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        On Error GoTo 0
        ws_mail.AutoFilterMode = False
        With ws_mail
            .Columns("F").Hidden = True
            .Columns("M").Hidden = True
            .Columns("N").Hidden = True
            .Rows("6:7").ClearContents
        End With
        Set newbook = Workbooks.Add
        ws_mail.Copy Before:=Workbooks(newbook.FullName).Sheets(1)
        Application.DisplayAlerts = False
        For Each ws In newbook.Worksheets
            If ws.Name <> ws_mail.Name Then ws.Delete
        Next ws
        ' Set the active cell to A1 and scroll to row 11
        With newbook.Sheets(1)
            .Activate
            .Range("A11").Select
            ActiveWindow.ScrollRow = 11
            .Range("A1").Select
        End With
        newbook.SaveAs (fname)
        Application.DisplayAlerts = True
        newbook.Close
        Call emailer(ws_list.Range("D" & i).Value, ws_list.Range("C" & i).Value, fname)
        Kill (fname)
end_loop:
        'done with email, delete temporary sheet
        Application.DisplayAlerts = False
        ws_mail.Delete
        Application.DisplayAlerts = True
    Next i

End Sub

Sub emailer(email As String, user As String, fname As String)

    Dim olook As Object
    Dim omail As Object
    Dim my_message As String
    Dim my_sig As Variant

    ' HTML content
    my_message = "<!DOCTYPE html>" & _
                 "<html>" & _
                 "<head>" & _
                 "<style>" & _
                 "body { font-family: 'Aptos', sans-serif; font-size: 10pt; }" & _
                 "</style>" & _
                 "</head>" & _
                 "<body>" & _
                 "<p>Hi " & user & ",</p>" & _
                 "<p>Hope you are well.</p>" & _
                 "<p>I am reaching out to gain a better understanding of how our XX system xxXX and handles the charge-out of XX for fixed/personnel costs. Specifically, I would like to discuss the following points:</p>" & _
                 "<ul>" & _
                 "<li>The process for allocating rates by individuals and product lines.</li>" & _
                 "<li>How the percentage allocations are determined and assigned.</li>" & _
                 "<li>Any key considerations or methodologies used in this allocation process.</li>" & _
                 "</ul>" & _
                 "<p>In the attached workbook, if you can kindly assign the % the respective XX will be working in the corresponding division (columns W:Z).</p>" & _
                 "<p>For context, I am currently working with XX from the XX Division, and this inquiry is specifically focused on the XX of fixed/personnel costs within the XX Division. As part of our ongoing efforts to realign our XX, it is crucial that we fully understand the mechanics behind these allocations. Your expertise and insights would be greatly appreciated.</p>" & _
                 "<p>Could we schedule a meeting at your earliest convenience to discuss this in detail? I am looking forward to your response and am available for a meeting at a time that works best for you.</p>" & _
                 "<p>Thank you so much for your cooperation.</p>" & _
                 "</body>" & _
                 "</html>"

    Set olook = CreateObject("Outlook.Application")
    Set omail = olook.CreateItem(0)
    omail.Display
    my_sig = omail.HTMLBody
    With omail
        .To = email
        .Subject = "Input required: XX XX and recharge %"
        .HTMLBody = my_message & my_sig
        .Attachments.Add fname
        '.Send
    End With

End Sub

I made some changes to my macro, added columns etc, and revise the code. for some odd reason, it's not attaching the file when it creates the email. it's creating the email in outlook perfectly, just not attaching the file anymore. Its showing the error as "error attaching file:[listed path] ---- see thread below for vba that is not working

**jw01** · 08-05-2024, 03:19 PM

below is the updated macro that is NOT attaching the file. CAN SOMEONE PLS ASSIST?

Sub mailer()

    Dim ws_list As Worksheet
    Dim ws_mail As Worksheet
    Dim newbook As Workbook
    Dim i As Long
    Dim lr As Long
    Dim lr2 As Long
    Dim fname As String
    Dim recipientName As String
    Dim my_message As String

    ' Define the HTML email message
    my_message = "<!DOCTYPE html>" & _
                 "<html>" & _
                 "<head>" & _
                 "<style>" & _
                 "body { font-family: 'Aptos', sans-serif; font-size: 10pt; }" & _
                 "</style>" & _
                 "</head>" & _
                 "<body>" & _
                 "<p>Hi [person],</p>" & _
                 "<p>Hope you are well.</p>" & _
                 "<p>I am reaching out to gain a better understanding of how our xx xx and handles the charge-out of xx for fixed/personnel costs. Specifically, I would like to discuss the following points:</p>" & _
                 "<ul>" & _
                 "<li>The process for xx by individuals and product lines.</li>" & _
                 "<li>How the percentage xx are determined and assigned.</li>" & _
                 "<li>Any key considerations or methodologies used in this allocation process.</li>" & _
                 "</ul>" & _
                 "<p>In the attached workbook, if you can kindly assign the % the respective xx will be working in the corresponding xx (columns W:Z).</p>" & _
                 "<p>For context, I am currently working with xx from the xx Division, and this inquiry is specifically focused on the allocations of fixed/personnel costs within the xx Division. As part of our ongoing efforts to realign our xx, it is crucial that we fully understand the mechanics behind these allocations. Your expertise and insights would be greatly appreciated.</p>" & _
                 "<p>Could we schedule a meeting at your earliest convenience to discuss this in detail? I am looking forward to your response and am available for a meeting at a time that works best for you.</p>" & _
                 "<p>Thank you so much for your cooperation.</p>" & _
                 "</body>" & _
                 "</html>"

    ' Set the worksheet references
    Set ws_list = ThisWorkbook.Worksheets("Email list")
    Set ws_mail = ThisWorkbook.Worksheets("Summary")

    ' Get the last row of email list data
    lr = ws_list.Range("C" & Rows.Count).End(xlUp).Row

    ' Exit if there are no names listed
    If lr < 11 Then Exit Sub

    For i = 11 To lr
        ' Get the recipient's name from column C
        recipientName = ws_list.Range("C" & i).Value

        ' Sanitize the recipientName to remove any invalid characters
        recipientName = Replace(recipientName, "/", "_")
        recipientName = Replace(recipientName, "\", "_")
        recipientName = Replace(recipientName, ":", "_")
        recipientName = Replace(recipientName, "*", "_")
        recipientName = Replace(recipientName, "?", "_")
        recipientName = Replace(recipientName, """", "_")
        recipientName = Replace(recipientName, "<", "_")
        recipientName = Replace(recipientName, ">", "_")
        recipientName = Replace(recipientName, "|", "_")

        ' Construct the file name with the recipient's name
        fname = "C:\Users\john.smith\xx\Desktop\Test\Consolidated IES_" & recipientName & ".xlsx"

        ' Copy the Summary sheet to a new workbook
        ws_mail.Copy

        ' The copied sheet will now be the active workbook
        Set newbook = ActiveWorkbook

        ' Convert columns C:AE to static values
        lr2 = newbook.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row
        newbook.Sheets(1).Range("C11:AE" & lr2).Value = newbook.Sheets(1).Range("C11:AE" & lr2).Value

        ' Turn off any filters
        newbook.Sheets(1).AutoFilterMode = False

        ' Filter by column Q to match names in the Email list (Column C)
        newbook.Sheets(1).Range("C10:BF" & lr2).AutoFilter field:=15, Criteria1:="<>*" & recipientName & "*"

        ' Delete rows where names don't match
        On Error Resume Next
        newbook.Sheets(1).Range("Q11:Q" & lr2).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        On Error GoTo 0

        newbook.Sheets(1).AutoFilterMode = False

        ' Exit loop if no data is available for this user
        If newbook.Sheets(1).Range("Q11").Value = vbNullString Then
            newbook.Close SaveChanges:=False
            GoTo end_loop
        End If

        ' Hide unnecessary columns
        With newbook.Sheets(1)
            .Columns("F").Hidden = True
            .Columns("K:M").Hidden = True
            .Columns("P:U").Hidden = True
            .Columns("AL:BF").Hidden = True
            .Rows("5:7").ClearContents
        End With

        ' Set the active cell to A1 and scroll to row 11
        With newbook.Sheets(1)
            .Activate
            .Range("A11").Select
            ActiveWindow.ScrollRow = 11
            .Range("A1").Select
        End With

        ' Save the new workbook with the personalized file name
        Application.DisplayAlerts = False
        Debug.Print "Saving file as: " & fname ' Debug message for tracking
        newbook.SaveAs fname
        Application.DisplayAlerts = True

        ' Confirm the file exists before proceeding to attach
        If Dir(fname) <> "" Then
            ' Call the emailer function to send email with the attachment
            Call emailer(ws_list.Range("D" & i).Value, recipientName, fname)
        Else
            MsgBox "File not saved properly: " & fname, vbExclamation
            newbook.Close SaveChanges:=False
            GoTo end_loop
        End If

        ' Close the temporary workbook
        newbook.Close SaveChanges:=False

        ' Delete the file after sending the email
        Debug.Print "Deleting file: " & fname ' Debug message for tracking
        Kill fname

end_loop:
        ' Continue to the next iteration
    Next i

End Sub

Sub emailer(email As String, user As String, fname As String)

    Dim olook As Object
    Dim omail As Object
    Dim my_message As String
    Dim my_sig As Variant

    ' HTML content
    my_message = "<!DOCTYPE html>" & _
                 "<html>" & _
                 "<head>" & _
                 "<style>" & _
                 "body { font-family: 'Aptos', sans-serif; font-size: 10pt; }" & _
                 "</style>" & _
                 "</head>" & _
                 "<body>" & _
                 "<p>Hi " & user & ",</p>" & _
                 "<p>Hope you are well.</p>" & _
                 "<p>I am reaching out to gain a better understanding of how our xx  and handles the charge-out of xx for fixed/personnel costs. Specifically, I would like to discuss the following points:</p>" & _
                 "<ul>" & _
                 "<li>The process for xx by individuals and product lines.</li>" & _
                 "<li>How the percentage allocations are determined and assigned.</li>" & _
                 "<li>Any key considerations or methodologies used in this allocation process.</li>" & _
                 "</ul>" & _
                 "<p>In the attached workbook, if you can kindly assign the % the respective employee will be working in the corresponding division (columns W:Z).</p>" & _
                 "<p>For context, I am currently working with xx from the xx Division, and this inquiry is specifically focused on the allocations of fixed/personnel costs within the xx Division. As part of our ongoing efforts to realign our xx, it is crucial that we fully understand the mechanics behind these allocations. Your expertise and insights would be greatly appreciated.</p>" & _
                 "<p>Could we schedule a meeting at your earliest convenience to discuss this in detail? I am looking forward to your response and am available for a meeting at a time that works best for you.</p>" & _
                 "<p>Thank you so much for your cooperation.</p>" & _
                 "</body>" & _
                 "</html>"

    ' Create Outlook application and email
    Set olook = CreateObject("Outlook.Application")
    Set omail = olook.CreateItem(0)
    omail.Display
    my_sig = omail.HTMLBody
    With omail
        .To = email
        .Subject = "Input required: xx and recharge %"
        .HTMLBody = my_message & my_sig

        ' Debugging: Print the file path to verify
        Debug.Print "Attaching file: " & fname

        ' Attach the file to the email
        On Error Resume Next
        .Attachments.Add fname
        If Err.Number <> 0 Then
            MsgBox "Error attaching file: " & fname, vbExclamation
            Debug.Print "Error attaching file: " & Err.Description
            Err.Clear
        End If
        On Error GoTo 0

        ' Display the email for review
        '.Send ' Uncomment this line to send automatically
    End With

End Sub

**jw01** · 08-05-2024, 09:49 PM

any thoughts on this guys?

**TMS** · 08-06-2024, 04:15 AM

No idea off the top of my head. I would try commenting out all the error handling and/or stepping through the code to see a) if it crashes and b) if it misses out any section of the code.

Fast answers need visual help. Please read the yellow banner at the top of this page on how to attach a file and a mocked up solution.

**Artik** · 08-06-2024, 06:00 PM

Try uncommenting the line with Send at the end of the 'emailer' procedure. With this setting, will the email be sent with an attachment?

Artik

**TMS** · 08-06-2024, 06:34 PM

In the original code, you set the file name early on to: fname = "C:\Users\john.smith\xx\Desktop\FP&A\Allocations\Test\Consolidated IES.xlsx"

In the failing code, you set the file name much later on: fname = "C:\Users\john.smith\xx\Desktop\Test\Consolidated IES_" & recipientName & ".xlsx"
where recipientName has been processed.

I'm guessing that line of code is either not executed, or the sanitisation has left something that shouldn't be there, or the code that attaches the file fails or isn't executed. Lots of options.

IMO, the only way to diagnose this is to switch off error handling and step through the code, checking the variabes and the route through the code.

VBA issue: file not attaching in email

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

VBA issue: file not attaching in email

Re: VBA issue: file not attaching in email

Re: VBA issue: file not attaching in email

Re: VBA issue: file not attaching in email

Re: VBA issue: file not attaching in email

Re: VBA issue: file not attaching in email

Thread Information

Users Browsing this Thread

Similar Threads

Block email address from attaching file

[SOLVED] Issue with attaching files to an email through VBA

[SOLVED] How to prevent VBA from attaching a particular file when it generates email

Attaching an embedded PDF file in my worksheet to a new email

[SOLVED] VBA code exporting to PDF but not attaching the file to the email.

Email (outlook) recipients attaching specific file name.

Attaching One Worksheet of a File to Email

Bookmarks

Bookmarks

Posting Permissions