VBA Macro emails with word document attachment

[TomAtlas]

Hi,

I am in need of sending a personalised email to a large number of personnel.

This email needs to have a word document attached that can be updated and returned to me.

So far I have the code which is working that sends the emails. I just can't seem to find how to attached a file.

Sub SendEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim r As Integer, x As Double
    For r = 2 To 2  'data in rows 2-2
'       Get the email address
        Email = Cells(r, 3)
       
'       Message subject
        Subj = "Profile Update"

'       Compose the message
        Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
        Msg = Msg & "As we are fast approaching the end of the year, we are going through an admin excerise to ensure we have the most up to date information on our system." & vbCrLf & vbCrLf
        Msg = Msg & "If you haven't already, please complete the attached form and return to me as soon as possible" & vbCrLf
        Msg = Msg & "Any questions, please feel free to contact me" & vbCrLf
        Msg = Msg & "Many Thanks" & vbCrLf & vbCrLf

        Msg = Msg & "Name" & vbCrLf
        Msg = Msg & "Position" & vbCrLf
       
       
'       Replace spaces with %20 (hex)
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
               
'       Replace carriage returns with %0D%0A (hex)
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
'       Create the URL
        URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg
   

'       Execute the URL (start the email client)
        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

'       Wait two seconds before sending keystrokes
        Application.Wait (Now + TimeValue("0:00:01"))
        Application.SendKeys "%s"
    Next r
   
End Sub

I am very new to VBA.

Any help would be very much appreciated!

 

[Chihiro]

What's your email client?

If using Outlook, I'd suggest different approach. Take a look at Ron's site. This is pretty common request.
https://www.rondebruin.nl/win/s1/outlook/mail.htm

In your sample, there's no indication of how or where to look for said Word document. Without all the details we won't be able to help you effectively.

 

[TomAtlas]

Hi Chihiro,

Apologies, yes I am using outlook.

The Document in question is stored locally, however I am using a thin client so it is actually on a central server not on the PC's internal storage. Does this make it more difficult?

I see the example in the link provided (thank you for that) but as there is no C: drive, I wasn't sure if there would have to be an alternate solution.

 

[Chihiro]

It won't matter, as long as drive letter is assigned (or server name/IP).

If network drive is mapped to X: drive. You'd access it same as C: drive. If using server name... something like...
\\ServerName\Folder\Filename
or replace servername with IP.

 

[Logit]

If you aren't opposed to taking a different macro :

Option Explicit

Sub Send_Email()

    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim i As Integer
  
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells
        Set OutLookApp = CreateObject("Outlook.application")
        Set OutLookMailItem = OutLookApp.CreateItem(0)
        With OutLookMailItem
                .To = c.Value
                .CC = "Your CC here"
                .BCC = "test"
                .Subject = "Your Subject here"
                .HTMLBody = "Your Body content here"
                .Attachments.Add c.Offset(i, 1).Value
                .Display
                '.Send
        End With
    Next c

End Sub

 

[TomAtlas]

Hi Logit,

Not at all opposed! That is a real help thanks!

Just one question, I have an additional column in sheet1 with the name of the email address owner.

I want to make each email a 'personal' one by beginning 'Dear *name*'

Is there a way of referencing the cell into the .HTMLBody line?

 

[Thangavel]

Try this:

.HTMLBody = "Your Body content here" & Sheet1.Range("A1")

 

[TomAtlas]

Hi Thangavel,

Thanks for that but unfortunately it didn't work.

There is quite a bulk of text to go in the body, would that be making a difference?

Sorry, very new to this!

 

[Thangavel]

That bulk text is in a cell or you will update in the code itself?

To add in code try this:

 Dim strbody As String

strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

.HTMLBody = strbody

 

[TomAtlas]

That seems to have worked!

Thanks very much for your help.

One final thing, the reference for the persons name (& Sheet1.Range("A1"))

If i want that to loop down the list too, how do i go about doing that? So far, I am calling everyone by the name in cell A1?