excel macro to send outlook template

I dug a bit deeper and seems the template is just fine until I add the .HTMLBody.

How can I add the .HTMLBody over the template without it being messed up?

Once I add the .HTMLBody, then the template gets messed up.

If you examine the MailItem object (e.g., you can do that by stepping through your code, watching the MyItem variable)

The command:

Set MyItem = myOlApp.CreateItemFromTemplate("H:\FOLDER\Macros\Snapshot.oft")

Actually stores inside the .Body property.

So, when you add the command .HTMLBody = "Test", you are overwriting your template!

I don't know what your template looks like, but if you are trying to tag some text after the template, try this:

Sub test2()
Dim myOlApp As Object
Dim MyItem As Object
Dim strBody As String

    Set myOlApp = CreateObject("Outlook.Application")
    Set MyItem = myOlApp.CreateItemFromTemplate("H:\FOLDER\Macros\Snapshot.oft")

    With MyItem
        .To = Sheets("Clients").Range("A1")
        .Subject = "Monthly bill"
        strBody = .Body
        .Body = strBody & vbCrLf & vbCrLf & "Test"
        'Refer to and fill in variable items in template
        .Display
    End With
    Set MyItem = Nothing
    Set myOlApp = Nothing
End Sub

Select all Open in new window

If your Outlook template contains HTML, then I believe would need to combine the HTML from the template with the HTML from the rest of the body, then set that all at once in the .HTMLBody property.

Cheers,

Dave

Thanks Dave. So I changed it to add the following:

strBody = .HTMLBody
.HTMLBody = strBody & vbCrLf & vbCrLf & "Testing 1 2 3"

As my template is HTML. However, what I want to do is not add text under it, but add text IN the template.

Example the template contains a header and footer with a grey box all around. I want to enter text in the middle (replacing the xxxx). Can you do this?

See attached, i had to blur out the company info.
Untitled-1.jpg

See this primary tip used for developing your solution:
http://msdn.microsoft.com/en-us/library/dd492012(v=office.12).aspx

Let's assume you want to replace the string "XXXTextToReplaceXXX".  Need to be unique enough with the parameter so you can find it and it doesn't confuse the HTML code as well. E.g., if you use a parameter like %TextToReplace% it will not find it as the HTML code generated from the .OFT file will interpret the % as something else.  I've tested this and saved the template as HTML so I assume that's what's going on with the OFT.  It took me a while (because I thought I was doing something wrong) to figure this out.  In the tip example it uses %Project_Type% so that's what I did in the template and no matter what I did, it would not find it.  I even created ReplyTo as in the tip example to no avail.  That's when I started to look at the bodyHTML that was being generated and it clued me in to this.

Ok - create your code with XXXTextToReplaceXXX in the template, and the code below will work.  I added the routine getNewHTML() to allow you to specify if you wanted your replacement text to be at the 1- beginning, 2- middle, or 3- end of the body.  Note the replacement text is optional and is not used in the function unless you choose the middle option.

I also created a little app, using ranges on the worksheet to specify the path to the OFT, the find and replacement string, and option of beginning, at keyword/middle, or end.  The routine used for that is called: SendEmailWTemplate()

Here's the code:

Option Explicit

Sub test2()
Dim myOlApp As Object
Dim MyItem As Object
Dim strBody As String
Dim strLink As String
Dim strLinkText As String
Dim strNewText As String

    Set myOlApp = CreateObject("Outlook.Application")
    Set MyItem = myOlApp.CreateItemFromTemplate("H:\FOLDER\Macros\Snapshot.oft")

    With MyItem
        .To = Sheets("Clients").Range("A1")
        .Subject = "Monthly bill"
        
        strNewText = "<p>this is a test</p>"

        '.HTMLBody = getNewHTML(.HTMLBody, strNewText, 1, vbNullString) 'test iAddOption = 0 @ beginning of body
        .HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX") 'test iAddOption = 1 @ replace search string in body
        '.HTMLBody = getNewHTML(.HTMLBody, strNewText, 3, vbNullString) 'test iAddOption = 2 @ end of body
        
        .Display
    End With
    Set MyItem = Nothing
    Set myOlApp = Nothing
End Sub
Sub SendEmailWTemplate()
Dim myOlApp As Object
Dim MyItem As Object
Dim strBody As String
Dim strLink As String
Dim strLinkText As String
Dim strNewText As String

    Set myOlApp = CreateObject("Outlook.Application")
    Set MyItem = myOlApp.CreateItemFromTemplate([oftTemplate]) 'using named range for template path

    With MyItem
        .To = Sheets("Clients").Range("A1")
        .Subject = "Monthly bill"
        
        strNewText = [replaceString]

        Select Case [desiredoption]
            Case 1
                .HTMLBody = getNewHTML(.HTMLBody, strNewText, 1, vbNullString) 'test iAddOption = 0 @ beginning of body
            Case 2
                .HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, [findString]) 'test iAddOption = 1 @ replace search string in body
            Case 3
                .HTMLBody = getNewHTML(.HTMLBody, strNewText, 3, vbNullString) 'test iAddOption = 2 @ end of body
        End Select
        
        .Display
    End With
    Set MyItem = Nothing
    Set myOlApp = Nothing
End Sub
Function getNewHTML(strHTML As String, strBodyTagReplace As String, iAddOption As Integer, Optional strBodyTag As String = vbNullString) As String
'Source: Learnings from - http://msdn.microsoft.com/en-us/library/dd492012(v=office.12).aspx
'supports adding at the beginning of the message, before the template, adding in the middle of the existing HTML, or at the end of the message
'iAddOption = 1 'beginning of email body - keys in on <body and inserts after the <body xxx declaration
'iAddOption = 2 'middle of email body (requires a search string to be added)
'iAddOptin = 3 'end of the email body - keys in on and inserts before </body>

Dim intTagStart As Integer
Dim intTagEnd As Integer

    Select Case iAddOption
        Case 1 'Insert at beginning of email body
            intTagStart = InStr(1, strHTML, "<body", vbTextCompare)
            intTagEnd = InStr(intTagStart + 5, strHTML, ">")
            strBodyTag = Mid(strHTML, intTagStart, intTagEnd - intTagStart + 1)
            getNewHTML = Replace(strHTML, strBodyTag, strBodyTagReplace)
        Case 2 'Search for key string and insert in the middle of email body
            getNewHTML = Replace(strHTML, strBodyTag, strBodyTagReplace)
        Case 3 'Append to end of email body
            getNewHTML = Replace(strHTML, "</body>", strBodyTagReplace, 1, 1, vbTextCompare)
    End Select
    
End Function

Select all Open in new window

See attached.

Cheers,

Dave
sendEmailUsingTemplate-r2.xlsm

Thanks Dave.

The code looks great.

One question, if I want to replace strNewText to equal a range, how can I do that?

it doesn't seem to like: strNewText = Cells.Range("a3:e60")

Also, if I want to add an additional field to replace? i.e. I added XXXDateXXX to the template which I want to replace with the current date.

I figured out the date item.

All thats left is having strNewText as the range.

Thanks!

You can't assign a text field to an entire range.  If you want to concatenate those cells together, use ths:

dim vNewText as variant
dim i as long

vNewText = Cells.Range("A3:E60)

for i = lbound(vnewtext) to ubound(vnewtext)
  if strNewText = vbnullstring then
     strNewText = vnewtext(i)
  else
    strNewText = strNewText & vbcrlf & vnewtext(i)
  end if
next i

Select all Open in new window

now, strNewText has the data.

>> Also, if I want to add an additional field to replace? i.e. I added XXXDateXXX to the template which I want to replace with the current date.

Go for it!  Just add the code to the case statement and repeat the statements at each case but with your next findString.

Any other questions?

Cheers,

Dave

hmm. doesnt seem to be working right.

i dont.

what's wrong with this?

Sub LightningBolt1_Click()
Dim myOlApp As Object
Dim MyItem As Object
Dim rangebody As Range
Dim strBody As String
Dim strLink As String
Dim strLinkText As String
Dim strNewText As String
Dim strNewText2 As String
Dim vNewText As Variant


Set myOlApp = CreateObject("Outlook.Application")
Set MyItem = myOlApp.CreateItemFromTemplate("H:\file.oft")

With MyItem
.bcc = "Clients Names Here"
.cc = "cc here"
.Subject = "subject here"
strBody = .HTMLBody
'Set rangebody = Cells.Range("a3:e60")
'strNewText = "<p>this is a test</p>"
strNewText2 = Date

vNewText = Cells.Range("A3:E60")
Dim i As Long
For i = LBound(vNewText) To UBound(vNewText)
  If strNewText = vbNullString Then
    'strNewText = vNewText(i)
  Else
    strNewText = strNewText & vbCrLf & vNewText(i)
  End If
Next i
         
.HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX") 'test iAddOption = 1 @ replace search string in body
.HTMLBody = getNewHTML(.HTMLBody, strNewText2, 2, "XXXDateXXX")
.Display
End With
Set MyItem = Nothing
Set myOlApp = Nothing

End Sub

Select all Open in new window

.HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX")  'Assume this one works.

Let's try this.

strNewText =.HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX")
strNewText = .HTMLBody = getNewHTML(.HTMLBody, strNewText2, 2, "XXXDateXXX")

Now in each line, you can examine strNewText to make sure the changes happend in the first, then the second instance.  Do a instr to test that XXXTextToReplaceXXX exists before the first statement, and that it doesnt and your substitution (or part of it does)

Then do the same on the second.

Finally, add the line:

.HTMLBody = strNewText

PS - why did you comment out line 29?

Dave

let me try now.

line 29 was a typo, i didnt comment it out.

says this subscript out of range:
strNewText = vNewText(i)

The strnewtext and strnewtext2 worked fine as expected until I tried to have strNewtext be the range.

vNewText = Cells.Range("A3:E60")
Dim i As Long
For i = LBound(vNewText) To UBound(vNewText)
  If strNewText = vbNullString Then
    strNewText = vNewText(i)
 Else
    strNewText = strNewText & vbCrLf & vNewText(i)
  End If
Next i
         
.HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX") 'test iAddOption = 1 @ replace search string in body
.HTMLBody = getNewHTML(.HTMLBody, strNewText2, 2, "XXXDateXXX")
.HTMLBody = strNewText
.Display
End With
Set MyItem = Nothing
Set myOlApp = Nothing

End Sub

Select all Open in new window

same error even when i change .html body to:

strNewText = .HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX") 'test iAddOption = 1 @ replace search string in body
strNewText = .HTMLBody = getNewHTML(.HTMLBody, strNewText2, 2, "XXXDateXXX")
.HTMLBody = strNewText

Select all Open in new window

subscript out of range:
    strNewText = vNewText(i)

Also, that's a large range to be sending the way I teed it up to you.  Let's scrap that.

What you need is a range to HTML function.  Here's a link to Ron deBruin's and I was playing with that on another project, yesterday:
http://www.rondebruin.nl/mail/folder3/mail4.htm

Add that function and use it to convert the range to HTML then do your getHTML function to do replacements.

Dave

PS - the code I gave you for variant = range won't work for the range you've selected, it works for a one dimensional range.  We don't need it anyway, the RangeToHTML should give you a good representation of what the worksheet looks like.  There's also a way to copy and paste it in as a picture and if we need that, I can dig up a link to a past solution that has that approach.

Dave

i added the function, your right in that it doesnt work right with the range now.

i tried your last code change and it bring up the email with the range but not the template.

I don't need to copy and paste as a picture, just want to get the data in the template.

how can i do it?

snippet

'strNewText = "<p>this is a test</p>"
strNewText = RangetoHTML(Range("A3:E60"))
strNewText2 = Date

'vNewText = Cells.Range("A3:E60")
'Dim i As Long
'For i = LBound(vNewText) To UBound(vNewText)
  'If strNewText = vbNullString Then
    'strNewText = vNewText(i)
 'Else
    'strNewText = strNewText & vbCrLf & vNewText(i)
 ' End If
'Next i
         
.HTMLBody = getNewHTML(.HTMLBody, strNewText, 2, "XXXTextToReplaceXXX") 'test iAddOption = 1 @ replace search string in body
.HTMLBody = getNewHTML(.HTMLBody, strNewText2, 2, "XXXDateXXX")
.HTMLBody = strNewText
.Display
End With
Set MyItem = Nothing
Set myOlApp = Nothing

Select all Open in new window

Its working for me with a top and bottom picture and two replacement strings in the middle - see my template, attached and try the Excel file I uploaded for testing.  

Then, with your setup, make sure your replacement text strings exist, open your template and validate.


See attached,

DOWNLOAD the template then RENAME extension to .OFT

Cheers,

Dave
Test-HTML--2-.zip

i tested with your .oft and it pastes the range but no template.

did you look at my code? am i doing something different?

disregard. i got it!

i had to comment out: .HTMLBody = strNewText


thanks again dave!

Great answer, great person, great to deal with!

Thanks for your kind words.  You know, I'd never had to work with MS Outlook templates nor modifying HTML against a template. It took some digging and couldn't find anyone who'd used a template, then did string replacement in the HTML at the same time - so it was really new development for me rather than adapting something that already existed (albeit, not from scratch).

So, thanks for that question as I enjoyed working with you and the overall experience as well!

Dave

hey dave,
"There's also a way to copy and paste it in as a picture and if we need that, I can dig up a link to a past solution that has that approach."

can you pass that along please? I want to try that  and see if my sheet comes out better if as an image.

hey dave,
"There's also a way to copy and paste it in as a picture and if we need that, I can dig up a link to a past solution that has that approach."

can you pass that along please? I want to try that  and see if my sheet comes out better if as an image.

I thought I did respond to your last question.  Sorry about that - the website and I (one of "us" anyway) went bonkers :)

Here's the link to past solution where I crafted a modified RangeToHTML2() routine.  The HTML would need to be merged to whatever you already have:

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Objects/Q_27563263.html

Here's code I believe Ron deBruin authored, which uses the publishObjects approach:

Public Function RangetoHTML2()
' You can't use this function in Excel 97
Dim fso As Object
Dim ts As Object
Dim TempFile As String

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    With ActiveWorkbook.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=ActiveSheet.Name, _
         Source:=ActiveSheet.UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML2 = ts.ReadAll
    ts.Close
    Set ts = Nothing
    Set fso = Nothing
    Kill TempFile
End Function

Select all Open in new window

The code posted might be more flexible than my copy to GIF then import into HTML approach in my modified RangeToHTML2 approach.  The function needs to be modified so you can pass it the range rather than using the activesheet's used range.

Cheers,

Dave

cheers!