Question

我之前从未使用VBA进行mailmerge，并且最近继承了几年前创建的docm。我的两个问题是： 1.如何将电子邮件作为HTML发送？尝试过wdMailFormatHTML但它不起作用。 2.数据源位于带有标题的excel文件中。 “table”标题与下面的文本不对齐。我想要的是标题调整宽度以匹配下面的数据。已尝试过多种方法来修复文档中的对齐但无济于事。还尝试将列宽添加到代码中，但我可能做错了，因为似乎没有任何工作。

以下是原始代码。如果有人可以提供帮助，我将不胜感激。

Sub RunMerge()
Application.ScreenUpdating = False
Dim Doc1 As Document, Doc2 As Document, Doc3 As Document, StrDoc As String
Set Doc1 = ThisDocument
StrDoc = ThisDocument.Path & "\EmailDataSource.doc"
If Dir(StrDoc) <> "" Then Kill StrDoc
With Doc1.MailMerge
  If .State = wdMainAndDataSource Then
    .Destination = wdSendToNewDocument
    .Execute
    Set Doc2 = ActiveDocument
  End If
End With
Call EmailMergeTableMaker(Doc2)
With Doc2
  .SaveAs FileName:=StrDoc, AddToRecentFiles:=False, FileFormat:=wdFormatDocument
  StrDoc = .FullName
  .Close
End With
Set Doc2 = Nothing
Set Doc3 = Documents.Open(FileName:=Doc1.Path & "\Email Merge Main Document.doc", _
  AddToRecentFiles:=False)
With Doc3.MailMerge
  .MainDocumentType = wdEMail
  .OpenDataSource Name:=StrDoc, ConfirmConversions:=False, ReadOnly:=False, _
LinkToSource:=True, AddToRecentFiles:=False, Connection:="", SQLStatement:="", _
SQLStatement1:="", SubType:=wdMergeSubTypeOther
  If .State = wdMainAndDataSource Then
    .Destination = wdSendToEmail
    .MailAddressFieldName = "Recipient"
    .MailSubject = "TrackView follow-up - Missing timesheets/approvals"
.MailFormat = wdMailFormatPlainText
.Execute
  End If
End With
Doc3.Close SaveChanges:=False
Set Doc3 = Nothing
Application.ScreenUpdating = True
End Sub
Sub EmailMergeTableMaker(DocName As Document)
Dim oTbl As Table, i As Integer, j As Integer, oRow As Row, oRng As Range, strTxt As String
With DocName
  .Paragraphs(1).Range.Delete
  Call TableJoiner
  For Each oTbl In .Tables
  j = 2
    With oTbl
      i = .Columns.Count - j
      For Each oRow In .Rows
        Set oRng = oRow.Cells(j).Range
        With oRng
          .MoveEnd Unit:=wdCell, Count:=i
          .Cells.Merge
          strTxt = Replace(.Text, vbCr, vbTab)
          On Error Resume Next
          If Len(strTxt) > 1 Then .Text = Left(strTxt, Len(strTxt) - 2)
        End With
      Next
    End With
  Next
  For Each oTbl In .Tables
    For i = 1 To j
      oTbl.Columns(i).Cells.Merge
    Next
  Next
  With .Tables(1)
    .Rows.Add BeforeRow:=.Rows(1)
    .Cell(1, 1).Range.Text = "Recipient"
    .Cell(1, 2).Range.Text = "Data"
  End With
  .Paragraphs(1).Range.Delete
  Call TableJoiner
    End With
    Set oRng = Nothing
    End Sub
    Private Sub TableJoiner()
Dim oTbl As Table
For Each oTbl In ActiveDocument.Tables
  With oTbl.Range.Next
    If .Information(wdWithInTable) = False Then .Delete
  End With
Next
End Sub

Answer 1

使用mailitem的HTMLBody属性

Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
    .Attachments.Add
    .body = ""
    .CC = ""
    .HTMLBody = ""
    .subject = ""
    .to = emailTo
    .Send
End With
On Error GoTo 0
Set OutMail = Nothing

Answer 2

这里至少有两个潜在的问题。

一个是wdMailFormatHTML参数仅适用于完整版本的Outlook，而不适用于Outlook Express等，即Outlook必须是相关系统上的默认电子邮件客户端才能使用。（其他电子邮件客户端显然＆＃34;做＆＃34; HTML电子邮件 - 只是因为没有人知道它们与Word用来发送HTML电子邮件的机制有关。）

假设您使用Outlook，第二个问题是电子邮件合并过程只是通过电子邮件发送已放置在EmailDataSource.doc的数据列中的文本，这是数据源合并到电子邮件。 EmailMergeTableMaker例程目前的工作方式，该数据将是一个以制表符分隔的文本块。 Word可能会将标签扩展到一些空白区域，但它不会生成HTML表格。这就是可能对齐问题的根源。如果是这样，您需要确保每个单元格都包含一个表格。

通过重新思考EmailMergeTableMaker的工作方式，可能会更好。以下＆＃34;快速修复＆＃34;这里处理了一些样本数据，但我没有测试例如单元格为空的情况。

在此代码之后......

  With .Tables(1)
    .Rows.Add BeforeRow:=.Rows(1)
    .Cell(1, 1).Range.Text = "Recipient"
    .Cell(1, 2).Range.Text = "Data"
  End With
  .Paragraphs(1).Range.Delete
  Call TableJoiner

...插入以下内容：

  ' you should really move this Dim statement to the top 
  ' of the Sub and merge it with the existing Dim
  Dim oCellRng as Range
  With .Tables(1)
    For i = 2 To .Rows.Count
      Set oCellRng = .Cell(i, 2).Range
      oCellRng.MoveEnd wdCharacter, -1
      oCellRng.ConvertToTable vbTab
      Set oCellRng = Nothing
    Next
  End With

如果您不使用Outlook，那么您将无法直接使用MailMerge 来创建HTML格式的消息，您显然无法使用使用Outlook对象模型来做到这一点，所以我认为你必须考虑生成HTML格式的电子邮件并以其他方式发送它们（例如直接通过SMTP），但这是另一个故事。

另一种通过Outlook发送电子邮件的方法是自动化Outlook，正如Thomas Inzina所建议的那样。但是，这还需要您对合并的工作方式进行其他更改。

FWIW您正在使用的例程来自于＆＃34; macropod＆＃34; - 我没有链接，但搜索＆＃34; macropod目录MailMerge教程＆＃34;可能会引导您并以其他方式解决此类问题。

Mailmerge MailFormat和alighnment问题

2 个答案: