find/replace text using VBA

[JoeMajestee]

Hi all.

I am working on an Excel 2003 macro that emails from Outlook using a template. The template is, of course, HTML. I wish to replace some text in the template with other text. I am using worksheetfunction.replace with some success, but think there might be a non worksheet function ie. VBA function that does it better or the same.

The pertinent code snippet is:

        For Each c1 In Range(Cells(1, 1), Cells(1, Cells(1, 200).End(xlToLeft).Column))
            strHTMLbody = Application.WorksheetFunction.Replace _
                (strHTMLbody, InStr(1, strHTMLbody, c1.Value, vbTextCompare), _
                Len(c1.Value), Cells(c.Row, c1.Column).Value)
            OutMail.htmlbody = strHTMLbody
        Next c1

The macro works almost. Every now and then it won't do the replace in one of several replacements and it is consistently the same replacement. At first I realized it is because the HTML got borked up so the text being manipulated might appear to read "watermelon" but looking at the HTML result was "wa><span something>termelon". I have since made sure the text being replaced actually existed as text in the htmlbody, so that is not causing my problem. I have carefully copied and pasted, etc, to be sure there was not an errant space or something in the text either.

Thanks.

 

[JoeMo]

Take a look at the Range.Replace method in Excel's VBA help. It would allow you to rewrite your snippet to something like this:

With Range(Cells(1, 1), Cells(1, Cells(1, 200).End(xlToLeft).Column))
            strHTMLbody = .Replace(strHTMLbody, other arguments here.......)
            OutMail.htmlbody = strHTMLbody
End With

 

[JoeMajestee]

Thanks Joe. Will try it next week.

 

[JoeMajestee]

ARRRRgh. Just noticed I failed to give a piece of code! The strHTMLbody variable starts out with the htmltext from the outlook template. Here's the whole code for reference. So I don't think range.replace would be appropriate.

Sub EmailStuff()
'gets it's type from sheet name
Dim strTemplate As String, iTO As Integer, iCC As Integer, iBCC As Integer, iATT As Integer, iSent As Integer
Dim strATMTPath As String, rngToSend As Range, c As Range, c1 As Range, strATMT As String, oFound
Dim strCC As String, strBCC As String, strTO As String, strHTMLbody As String
strTemplate = "c:\MyTemplate.oft"
strATMTPath = "c:\MyAttachments\"
Set oFound = Rows(1).Find("Email Address")
iTO = oFound.Column
Set oFound = Rows(1).Find("CC email")
If Not oFound Is Nothing Then iCC = oFound.Column
Set oFound = Rows(1).Find("BCC email")
If Not oFound Is Nothing Then iBCC = oFound.Column
Set oFound = Rows(1).Find("ATMT 1")
If Not oFound Is Nothing Then iATT = oFound.Column
Set oFound = Rows(1).Find("Sent")
Set rngToSend = Range(Cells(2, iTO), Cells(Cells(60000, iTO).End(xlUp).Row, iTO))
For Each c In rngToSend
    If Not IsEmpty(c.Value) And IsEmpty(Cells(c.Row, iSent).Value) Then
        strTO = c.Value
        If iCC > 0 Then strCC = Cells(c.Row, iCC).Value
        If iBCC > 0 Then strBCC = Cells(c.Row, iBCC).Value
        If Cells(c.Row, iATT).Value <> "" Then
            strATMT = Dir(strATMTPath)
            Do While InStr(1, strATMT, Trim(Cells(c.Row, iATT).Value), vbTextCompare) < 1
                strATMT = Dir()
            Loop
        End If
        Dim OutApp As Object, OutMail As Object
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItemFromTemplate(strTemplate)
        On Error Resume Next
'manipulate body
        strHTMLbody = OutMail.htmlbody
        For Each c1 In Range(Cells(1, 1), Cells(1, Cells(1, 200).End(xlToLeft).Column))
            strHTMLbody = Application.WorksheetFunction.Replace _
                (strHTMLbody, InStr(1, strHTMLbody, c1.Value, vbTextCompare), _
                Len(c1.Value), Cells(c.Row, c1.Column).Value)
            OutMail.htmlbody = strHTMLbody
        Next c1
        With OutMail
            .To = strTO
            .CC = strCC
            .BCC = strBCC
            .Attachments.Add strATMTPath & strATMT
            .Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
        Cells(c.Row, iSent).Value = Format(Now(), "m/d")
    End If
Next c
End Sub