Sending formatted email using Excel

[Domski]

Hi,

Hold my hands up that this is a bit of a cross-post: http://vbaexpress.com/forum/showthread.php?t=29553

Having recently moved from Notes to Outlook I've been getting my hands dirty trying out some code.

What I was asked for was to develop something that would allow us to send out an email containing formatted text, images and personalised attachments to each of our 11,000+ employees using information extracted from our SAP HR system into Excel.

After some research I came across some code on Sue Mosher's site (www.outlookcode.com) that suggested the way to do this was to create the formatted email body text in a Word document and then use the code to convert that to an email and send it.

The code I have come up with is as follows:

Sub SendDocAsMsg()
'   Adapted from code found on Sue Mosher's site www.outlookcode.com
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim outApp As Outlook.Application
 
    Dim itm As Object
    Dim ID As String
    Dim blnWeOpenedWord As Boolean
 
    Dim bodyFname As String
 
    Dim wb1 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
 
    Dim lastRow As Long, myRow As Long
 
    Dim strPersNum As String
    Dim strEmail As String
    Dim strMergeName As String
 
    On Error Resume Next
 
'   Prompt user for data file and open
    TempFileName = Application.GetOpenFilename("Select data source (*.xls), *.xls")
    If TempFileName = "" Then
 
        MsgBox "No file selected!", vbCritical
        Exit Sub
 
    End If
 
    Application.ScreenUpdating = False
 
    Set wb1 = Workbooks.Open(TempFileName)
    TempFilePath = wb1.Path
    lastRow = wb1.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
 
    Set wrdApp = GetObject(, "Word.Application")
    If wrdApp Is Nothing Then
        Set wrdApp = CreateObject("Word.Application")
        blnWeOpenedWord = True
    End If
 
    bodyFname = ThisWorkbook.Path & "\Body Text.doc"
 
    For myRow = 2 To lastRow
 
    Application.StatusBar = "Processing record " & myRow - 1 & " of " & lastRow - 1
'   Set personnel number, name and email details
    strPersNum = wb1.Sheets("Sheet1").Cells(myRow, 1).Value
    strEmail = wb1.Sheets("Sheet1").Cells(myRow, 2).Value
    strMergeName = wb1.Sheets("Sheet1").Cells(myRow, 12).Value
 
    Set wrdDoc = wrdApp.Documents.Open _
      (Filename:=bodyFname, ReadOnly:=True)
    Set itm = wrdDoc.MailEnvelope.Item
    With itm
        .To = strEmail
        .Subject = "Metro card renewal"
        .ReplyRecipients.Add "joe.bloggs@leeds.gov.uk"
        .Attachments.Add TempFilePath & "\letters\" & strMergeName & ".doc"
        .Attachments.Add TempFilePath & "\Additional Info.doc"
        .Send
        ID = .EntryID
    End With
    Set itm = Nothing
 
    Set itm = outApp.Session.GetItemFromID(ID)
    itm.Send
    wrdDoc.Close False
    If blnWeOpenedWord Then
        wrdApp.Quit
    End If
    Next myRow
 
    Set wrdDoc = Nothing
    Set itm = Nothing
    Set wrdApp = Nothing
 
    wb1.Close
 
    Application.StatusBar = False
    Application.ScreenUpdating = True
 
End Sub​

The main problem is that it is very slow and takes around a minute to send 10 emails. Obviously with the volume we are planning to send the code is going to have to run for quite a long time. I'm thinking constructing the formatted text in HTML could be the way forward but I want to make this as easy as possible so as other people in the office can use it.

Has anyone else got suggestions as to a better way to achieve this sort of thing or how the code could be made more efficient.

Any help appreciated.

Dom​

 

[SydneyGeek]

Dom, a generic approach might be...

1. Create the HTML in something like Frontpage, Expression Web or Dreamweaver. You will need to use FONT tags for your formatting -- no style sheets
2. Copy the HTML (just the BODY section) into Excel, and paste as text in an empty worksheet. Now create placeholders like [FirstName], [Bonus], etc wherever you need to place variable content.

To use, pull the HTML into a string variable.
Build the output by replacing your placeholders with cell contents. Then push that string out to Outlook as the body of your new message.

Thinking aloud, but it might help. Also, check out Ken Puls' site (http://www.excelguru.ca) and Ron de Bruin's site (run a Google search -- can't remember the URL)

Denis