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