0
Sub sendCustEmails()

   Dim objOutlook As Object
   Set objOutlook = CreateObject("Outlook.Application")
   Dim objEmail As Object
   Set objEmail = objOutlook.CreateItem(olMailItem)
   
   
   intRow = 2
   
   While (ThisWorkbook.Sheets("Client_Data").Range("A" & intRow).Text <> "")
   
      Set objEmail = objOutlook.CreateItem(olMailItem)
      strMailSubject = ThisWorkbook.Sheets("Mail_Details").Range("A2").Text
      strMailBody = ThisWorkbook.Sheets("Mail_Details").Range("B2").Text
   
      
      strAudit = ThisWorkbook.Sheets("Client_Data").Range("A" & intRow).Text
      strPrefix = ThisWorkbook.Sheets("Client_Data").Range("B" & intRow).Text
      strName = ThisWorkbook.Sheets("Client_Data").Range("C" & intRow).Text
      strEmail = ThisWorkbook.Sheets("Client_Data").Range("D" & intRow).Text
      strAttachment = ThisWorkbook.Sheets("Client_Data").Range("E" & intRow).Text
      
      strMailBody = Replace(strMailBody, "<Prefix>", strPrefix)
      strMailBody = Replace(strMailBody, "<Name>", strName)
      strMailBody = Replace(strMailBody, "<Audit>", strAudit)
      
      
      With objEmail
          .To = CStr(strEmail)
          .Subject = strMailSubject
          .Body = strMailBody
          .Attachments.Add strFolder & "\" & strAttachment
          .Send
      End With
   
      intRow = intRow + 1
   
   Wend
   
   MsgBox "Done"

End Sub

I tried to create a code where we can send emails out with attachments to different people in Outlook. The email will go out to each person that are in the Excel sheet. However I would like to add my Outlook signature to each of these emails as I am sending them. How can I do that?

Tragamor
  • 3,594
  • 3
  • 15
  • 32

0 Answers0