Consulting

Results 1 to 8 of 8

Thread: Solved: Emailing From Excel Using an Outlook Template

  1. #1
    VBAX Expert
    Joined
    Feb 2010
    Posts
    696
    Location

    Solved: Emailing From Excel Using an Outlook Template

    I have been experimenting with various methods of generating Outlook emails from Excel. I've tried everything from generating a Distribution List, opening Outlook and placing the list of recipients in the TO: or BCC: fields, to scripts that export the distribution list to a TXT of CSV file.

    I recently came across a web page that describes a very interesting procedure which basically performs a mail merge using contacts maintained in Excel and merging with an existing DRAFT email in Outlook with "Template" in the subject line.

    The procedure is described in more detail at http://techtravelthink.blogspot.com/...excel-and.html.

    Unfortunately, the procedure is designed to work with Outlook 2010. Is there any way this could be redesigned to work on Outlook 2000?

    [vba]
    Private Function GetRichTextTemplate() As String

    Dim OLF As Outlook.MAPIFolder
    Dim olMailItem As Outlook.MailItem

    Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts )
    Set oItems = OLF.Items

    For Each Mailobject In oItems
    If Mailobject.subject = "Template" Then
    GetRichTextTemplate = Mailobject.HTMLBody
    Exit Function
    End If
    Next

    End Function

    [/vba]


    [vba]



    Public Sub SendMailMergeEmail()
    Dim OLF As Outlook.MAPIFolder
    Dim olMailItem As Outlook.MailItem
    Dim olContact As Outlook.Recipient
    Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderIn box)

    Dim subject As String
    subject = "<adv> Latest Product Update"

    Dim body As String
    Dim template As String
    template = GetRichTextTemplate()

    Dim cnumber As String
    Dim cname As String
    Dim email As String

    Dim row As Integer
    row = 2

    cnumber = Sheets("Main").Range("A" & row)
    cname = Sheets("Main").Range("B" & row)
    email = Sheets("Main").Range("C" & row)
    While cnumber <> ""
    Set olMailItem = OLF.Items.Add
    With olMailItem
    Set olContact = .Recipients.Add(email)
    olContact.Resolve

    .subject = subject
    .BodyFormat = olFormatRichText

    body = Replace(template, "{name}", cname)
    body = Replace(body, "{number}", cnumber)
    .HTMLBody = body

    .Send
    End With

    row = row + 1
    cnumber = Sheets("Main").Range("A" & row)
    cname = Sheets("Main").Range("B" & row)
    email = Sheets("Main").Range("C" & row)
    Wend

    Set olContact = Nothing
    Set olMailItem = Nothing
    Set OLF = Nothing
    End Sub
    </adv>

    [/vba]

  2. #2
    VBAX Mentor
    Joined
    Apr 2009
    Location
    Kingsbury
    Posts
    423
    Location
    Hi Opv

    Might find what you are looking for here, worth a look

    http://www.rondebruin.nl/

    Rob

  3. #3
    VBAX Expert
    Joined
    Feb 2010
    Posts
    696
    Location
    Thanks. I've browsed through that site, and even tried one or two of his scripts; however, I didn't find anything that created the type of EXCEL/Outlook mail merge ostensibly achieved in the sample code posted in my original post. If I could get it to work in Excel 2000 and Outlook 2000, I think it would be more appealing to me.

    Opv

  4. #4
    VBAX Expert
    Joined
    Feb 2010
    Posts
    696
    Location
    I tinkered around with the Function aspect of the puzzle and, by chance, seem to have got it working in Outlook 2000. At least it works in plain text. I haven't yet figured out how to test it with HTML format. At any rate, here is the function. Feel free to tell me how this could be more streamlined.

    [VBA]
    'FUNCTION TO GET OUTLOOK DRAFT EMAIL TEMPLATE
    Public Function getTemplate() As String

    Dim OutApp, myFolder, myDraft As Object
    Dim i As Integer

    Set OutApp = CreateObject("Outlook.Application")
    Set myFolder = OutApp.GetNamespace("MAPI")
    Set myDrafts = myFolder.GetDefaultFolder(16)

    For i = 1 To myDrafts.Items.Count
    If myDrafts.Items(i).subject = "Template" Then
    getTemplate = myDrafts.Items(i).body
    End If
    Next

    End Function
    [/VBA]

    I'm still trying to get the associated Sub figured out as to how it should be modified to work in Outlook 2000, with the objective being that the Template used from Outlook would be in Rich Text Format. Any help would be appreciated, as it relates to the Sub and the Function.

    Thanks,

    Opv

  5. #5
    VBAX Expert
    Joined
    Feb 2010
    Posts
    696
    Location
    Well, I fumbled around and successfully combined two different sets of code to achieve most of what I am attempting to do, which is generate email from Excel which uses an existing template in the DRAFT folder within Outlook, and then personalizes the emails to each person on the recipient list.

    The script below seems to work fine with the earlier Function I posted earlier. The combined Function and Subroutine seem to work as designed but each email is sent in plain text rather than retaining the HTML format of the original draft template. Is there any way the Function and/or Subroutine could be modified to capture and retain the HTML formatting?

    [vba]
    Sub TestFile()
    Dim OutApp, OutMail As Object
    Dim cell As Range
    Dim myBody As String

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    Sheets("Sheet2").Activate

    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And _
    LCase(Cells(cell.row, "C").Value) = "yes" Then

    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
    .To = cell.Value
    .subject = "LHS Joint-Class Reunion"
    myBody = getTemplate()
    myBody = Replace(myBody, "{name}", cell.Offset(0, -1))
    'body = Replace(myBody, "{number}", cell.Offset(0,?)
    .body = myBody

    'You can add files also like this
    '.Attachments.Add ("C:\test.txt")
    .Display 'Or Send 'Or use Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    End If
    Next cell

    cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    End Sub

    [/vba]

  6. #6
    VBAX Expert
    Joined
    Feb 2010
    Posts
    696
    Location
    I think I figured it out. The following code seems to do what I'm wanting it to do.

    [vba]
    'FUNCTION TO GET OUTLOOK DRAFT EMAIL TEMPLATE
    Public Function getTemplate() As String

    Dim OutApp, myFolder, myDrafts As Object
    Dim i As Integer

    Set OutApp = CreateObject("Outlook.Application")
    Set myFolder = OutApp.GetNamespace("MAPI")
    Set myDrafts = myFolder.GetDefaultFolder(16) 'DRAFT Folder

    For i = 1 To myDrafts.Items.Count
    If myDrafts.Items(i).subject = "Template" Then
    getTemplate = myDrafts.Items(i).HTMLbody
    End If
    Next

    End Function

    [/vba]

    [vba]
    Sub TestFile()
    Dim OutApp, OutMail As Object
    Dim cell As Range
    Dim myBody As String

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    Sheets("Sheet2").Activate

    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And _
    LCase(Cells(cell.row, "C").Value) = "yes" Then

    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
    .To = cell.Value
    .subject = "LHS Joint-Class Reunion"
    myBody = getTemplate()
    myBody = Replace(myBody, "{name}", cell.Offset(0, -1))
    'body = Replace(myBody, "{number}", cell.Offset(0,?)
    .HTMLbody = myBody

    'You can add files also like this
    '.Attachments.Add ("C:\test.txt")
    .Send 'Or use Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    End If
    Next cell

    cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    End Sub

    [/vba]
    Last edited by Opv; 03-25-2011 at 09:15 AM.

  7. #7
    VBAX Expert
    Joined
    Feb 2010
    Posts
    696
    Location
    My script is working fine. However, I am curious about something. When I've noticed that when I run the script (obviously from Excel) there are no Outlook active inspector windows opened, regardless of the number of recipients. The email is sent silently, so to speak.

    However, when I run a similar routine from within Outlook, a new inspector window is opened for each recipient, which can get ugly when there are more than a few recipients.

    Is application.screenupdating preventing the Outlook inspector windows when the Excel script is running or is something else responsible for that behavior? I don't think application.screenupdating will work with VBA code created in Outlook. Not sure, but I'd love to mimic the Excel behavior within Outlook.

  8. #8
    VBAX Expert
    Joined
    Feb 2010
    Posts
    696
    Location
    I may have resolved my previous question by using item.copy.send rather than just item.send.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •