find/replace text using VBA

JoeMajestee

New Member
Joined
Jul 15, 2009
Messages
42
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:

Code:
        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.
 

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,226
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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:
Code:
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

New Member
Joined
Jul 15, 2009
Messages
42
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.

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,109,369
Messages
5,528,287
Members
409,814
Latest member
Leon_Al

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top