Vba 替换Outlook邮件htmlbody中的多个值

Vba 替换Outlook邮件htmlbody中的多个值,vba,outlook,Vba,Outlook,我正在使用一个包含各种占位符的.oft(Outlook模板)文件。我想用字符串替换占位符 oft文件中的占位符为: 亲爱的~emp~ ~awd~ 我使用以下代码进行替换: .htmlbody = Vtemplatebody 'replacing Dear with Dear Name, name in Column A strFind = "Dear ~emp~" strNew = "Dear " & ws.Cells(i, "f") .htmlbody = Replace(.htmlb

我正在使用一个包含各种占位符的.oft(Outlook模板)文件。我想用字符串替换占位符

oft文件中的占位符为:

亲爱的~emp~ ~awd~

我使用以下代码进行替换:

.htmlbody = Vtemplatebody
'replacing Dear with Dear Name, name in Column A
strFind = "Dear ~emp~"
strNew = "Dear " & ws.Cells(i, "f")
.htmlbody = Replace(.htmlbody, strFind, strNew)

'Replace award
strFind1 = "~awd~"
strNew1 = ws.Cells(i, "h")
.htmlbody = Replace(.htmlbody, strFind1, strNew1)
第一个替换即~emp~正确地发生了,即字符串被ws.Cells(i,“f”)中的值替换。但是第二个viz~awd~没有被strNew1中的值替换


我正在做的事情有什么错误吗?还是应该用其他方法来做?

你运行过这段代码吗?如果是,在哪里?我希望编译器将
.htmlbody
转换为
.htmlbody

您给我们的代码太少,无法确定,但我怀疑是通配符。使用Replace方法时,星号(*)、问号(?)和波浪号(~)是通配符。替换函数应该是相同的,但我无法使用这些通配符

您可以尝试添加以下语句:

Vtemplatebody = Replace(Vtemplatebody,"~emp~","xxx")
Vtemplatebody = Replace(Vtemplatebody,"~awd~","yyy")
Debug.Print Vtemplatebody
在这些语句中,“xxx”和“yyy”表示
ws.Cells(i,“f”)
ws.Cells(i,“h”)
中的值。这些语句将允许您尝试不同的替换,并在即时窗口中看到效果。有了这样的陈述,就很容易尝试不同的价值观,并了解一些一旦发现就会显而易见的微妙问题

另一种选择是用百分比替换平铺。百分比不是通配符,因此使用它作为分隔符将消除通配符是问题的任何可能性


这些替换中有多少是必需的。你的方法在一个或两个替补中很好,但在很多替补中变得很难。如果这有帮助的话,我可以向您展示一种更好的技术。

大多数编程任务都可以通过几种不同的方法来解决。对于任何给定的任务,您如何选择最佳方法

如果您正在编写一个每天将处理数百万个事务的事务处理器,那么每节省一微秒的处理时间都是有价值的。程序员花上几个小时的时间使过程稍微快一点是值得的。然而,如果您正在编写事务处理器,那么选择VBA将是您的第一个错误。VBA并不像有些人认为的那样慢,但它的设计目的是易于编写,而不是快速执行。对于一个一天只执行一次的宏,或者在用户输入后隐藏了任何慢度的宏,最大限度地减少程序员的工作量是优先考虑的

一种算法可能比另一种算法更有效。我认为选择最合适的算法是一个设计决策,而不是一个编程决策。 测量程序员时间时,您需要考虑:

  • 原始程序员编写和调试代码需要多长时间
  • 维护程序员理解代码需要多长时间
  • 维护程序员更新和调试代码以满足新需求需要多长时间
我有时会看到我认为很聪明但很难理解的代码。最初的程序员花了多长时间才恢复正常?每个维护程序员需要多长时间才能理解代码的功能?很少有代码只写一次,而且从不更新。需求可能会发生变化,必须对代码进行审查和更新

考虑:

strFind = "Dear ~emp~"                           '
strNew = "Dear " & ws.Cells(i, "f")              ' Your code
.htmlbody = Replace(.htmlbody, strFind, strNew)  '

strFind = "~emp~"                                ' The code a maintenance
strNew = ws.Cells(i, "f")                        ' programmer
.htmlbody = Replace(.htmlbody, strFind, strNew)  ' might expect
strFind1 = "~awd~"
strNew1 = ws.Cells(i, "h")
.htmlbody = Replace(.htmlbody, strFind1, strNew1)
为什么在第一个查找值和新值中都包含“亲爱的”,而在第二个查找值和新值中却没有类似的操作?如果有原因,请添加注释,否则每个维护程序员都会花时间思考原因。最终会有人删除
“亲爱的”
。如果
“亲爱的”
很重要,这将导致以后出现问题

工作表的“f”列和“h”列中有什么内容?在这种情况下,这可能无关紧要。维护程序员不可能在不查看工作表的情况下修改代码,并且代码中的每一列可能只有一个引用。当有很多列和很多对这些列的引用时,这就成了一个问题。许多年前,我是一些代码的维护程序员,其中有很多关于第5列和第6列的引用。由于高于我工资等级的原因,这两列被交换了。代码中每一个“5”都必须替换为“6”,代码中每一个“6”都必须替换为“5”。这是一场噩梦,尤其是代码中还有很多其他的5s和6s。我在代码中避免使用文字。我喜欢这样的东西:

Const ColSalutation As String = “f”
:          :          :          :          :
strNew = ws.Cells(i, ColSalutation).Value
这有两个优点:(1)如果列位置发生变化,则对代码的一次修改和对列的所有引用都发生了变化;(2)有意义的名称,如colsaltation,使代码更易于阅读

考虑:

strFind = "Dear ~emp~"                           '
strNew = "Dear " & ws.Cells(i, "f")              ' Your code
.htmlbody = Replace(.htmlbody, strFind, strNew)  '

strFind = "~emp~"                                ' The code a maintenance
strNew = ws.Cells(i, "f")                        ' programmer
.htmlbody = Replace(.htmlbody, strFind, strNew)  ' might expect
strFind1 = "~awd~"
strNew1 = ws.Cells(i, "h")
.htmlbody = Replace(.htmlbody, strFind1, strNew1)
为什么
strFind1
strNew1
?将不再需要
strFind
strNew
中的值,因此可以使用这些变量。如果有原因,请记录下来,以避免维护程序员担心

为什么不:
.htmlbody=
替换(.htmlbody,“~awd~”,ws.Cells(i,“h”)`

在某些情况下,我认为将值移动到临时变量会使代码更清晰。我不确定它是否能让代码更清晰

下面我将介绍五个子程序,它们显示了满足您需求的不同方法。我建议每种方法何时最合适

我认为最简单的方法是创建一个新的启用宏的工作簿,其中包含两个工作表:“数据”和“替换”。宏
Prepare
将把值放在其他宏期望的工作表中

Sub Prepare()

  With Worksheets("Data")
    .Range("F5:I5").Value = Array("Jane", DateSerial(2020, 2, 1), 100, TimeSerial(12, 0, 0))
    .Range("G5").NumberFormat = "dddd mmmm d, yyyy"
    .Range("H5").NumberFormat = "$#,##0.00"
    .Range("I5").NumberFormat = "h:mm"
    .Columns.AutoFit
  End With
  With Worksheets("Replace")
    .Range("A1:B1").Value = Array("Original Value", "Column")
    .Range("A2:B2").Value = Array("%emp%", "f")
    .Range("A3:B3").Value = Array("%awd%", "h")
    .Range("A4:B4").Value = Array("%xyz%", "g")
    .Range("A5:B5").Value = Array("%uvw%", "i")
    .Columns.AutoFit
  End With

End Sub
方法1
基于您的方法:

Sub Approach1()

  Dim HtmlBody As String
  Dim i As Long
  Dim ws As Worksheet
  Dim strFind As String
  Dim strNew As String

  Set ws = Worksheets("Data")
  i = 5
  HtmlBody = "<body>Dear %emp%<p>I am pleased to inform you of an award of " & _
             "<b>%awd%</b> which you will receive on %xyz% at %uvw%.<p>Yours<p>" & _
             "John Doe</body>  "

  strFind = "Dear %emp%"
  strNew = "Dear " & ws.Cells(i, "f")
  HtmlBody = Replace(HtmlBody, strFind, strNew)

  strFind = "%awd%"
  strNew = ws.Cells(i, "h")
  HtmlBody = Replace(HtmlBody, strFind, strNew)

  strFind = "%xyz%"
  strNew = ws.Cells(i, "g")
  HtmlBody = Replace(HtmlBody, strFind, strNew)

  strFind = "%uvw%"
  strNew = ws.Cells(i, "i")
  HtmlBody = Replace(HtmlBody, strFind, strNew)

  Debug.Print HtmlBody

End Sub
对于方法1,每种方法需要三个新语句
OrigValuesAndCols = Array("%emp%", "f", _
                          "%awd%", "h", _
                          "%xyz%", "g", _
                          "%uvw%", "i")
Sub Approach3()

  Dim Col As String
  Dim HtmlBody As String
  Dim i As Long
  Dim Inx As Long
  Dim OrigValuesAndCols As Variant
  Dim ws As Worksheet

  Set ws = Worksheets("Data")
  i = 5
  HtmlBody = "<body>Dear %emp%<p>I am pleased to inform you of an award of " & _
             "<b>%awd%</b> which you will receive on %xyz% at %uvw%.<p>Yours<p>" & _
             "John Doe</body>  "

  OrigValuesAndCols = Array("%emp%", "f", _
                            "%awd%", "h", _
                            "%xyz%", "g", _
                            "%uvw%", "i")

  For Inx = LBound(OrigValuesAndCols) To UBound(OrigValuesAndCols) Step 2
    Col = OrigValuesAndCols(Inx + 1)
    HtmlBody = Replace(HtmlBody, OrigValuesAndCols(Inx), ws.Cells(i, Col).Text)
  Next

  Debug.Print HtmlBody

End Sub
OrigValues = VBA.Array("%emp%", "%awd%", "%xyz%", "%uvw%")
NewValues = VBA.Array(ws.Cells(i, "f").Text, ws.Cells(i, "h").Text, _
                      ws.Cells(i, "g").Text, ws.Cells(i, "i").Text)
Sub Approach4()

  Dim HtmlBody As String
  Dim i As Long
  Dim Inx As Long
  Dim NewValues As Variant
  Dim OrigValues As Variant
  Dim ws As Worksheet

  Set ws = Worksheets("Data")
  i = 5
  HtmlBody = "<body>Dear %emp%<p>I am pleased to inform you of an award of " & _
             "<b>%awd%</b> which you will receive on %xyz% at %uvw%.<p>Yours<p>" & _
             "John Doe</body>  "

  OrigValues = VBA.Array("%emp%", "%awd%", "%xyz%", "%uvw%")
  NewValues = VBA.Array(ws.Cells(i, "f").Text, ws.Cells(i, "h").Text, _
                        ws.Cells(i, "g").Text, ws.Cells(i, "i").Text)

  For Inx = 0 To UBound(NewValues)
    HtmlBody = Replace(HtmlBody, OrigValues(Inx), NewValues(Inx))
  Next

  Debug.Print HtmlBody

End Sub
Row|       A      |   B  |
   |--------------+------|
  1|Original Value|Column|
   |--------------+------|
  2|%emp%         |f     |
   |--------------+------|
  3|%awd%         |h     |
   |--------------+------|
  4|%xyz%         |g     |
   |--------------+------|
  5|%uvw%         |i     |
   |--------------+------| 
Sub Approach5()

  Dim ColData As String
  Dim HtmlBody As String
  Dim NewValue As String
  Dim OrigValue As String
  Dim RowData As Long
  Dim RowRplcCrnt As Long
  Dim RowRplcLast As Long
  Dim wsData As Worksheet
  Dim wsRplc As Worksheet

  Set wsData = Worksheets("Data")
  Set wsRplc = Worksheets("Replace")
  RowData = 5
  HtmlBody = "<body>Dear %emp%<p>I am pleased to inform you of an award of " & _
             "<b>%awd%</b> which you will receive on %xyz% at %uvw%.<p>Yours<p>" & _
             "John Doe</body>  "

  With wsRplc
    RowRplcLast = .Cells(, Rows.Count, 1).End(xlUp).Row
  End If

  For RowRplcCrnt = 2 To rowrpllast
    With wsRplc
      OrigValue = .Cells(RowRplcCrnt, 1).Value
      ColData = .Cells(RowRplcCrnt, 2).Value
    End With
    NewValue = ws.Cells(RowData, Col).Text
    HtmlBody = Replace(HtmlBody, OrigValue, NewValue)
  Next

  Debug.Print HtmlBody

End Sub