Mailmerge MailFormatと一般的な問題

Question

私は以前にmailmergeにVBAを使用していませんでしたが、最近数年前に作成したdocmを継承しました。私の2つの問題は： 1.電子メールをHTMLとして送信するにはどうすればよいですか？ wdMailFormatHTMLを試しましたが、動作しません。 2.データソースはヘッダー付きのExcelファイルにあります。 「表」ヘッダーは、以下のテキストと揃っていません。私が望むのは、ヘッダーが以下のデータと一致するように幅を調整することです。ドキュメント内での整列を修正するためのさまざまな方法を試しましたが、無駄です。また、コードに列の幅を追加しようとしましたが、おそらく何も動作していないように間違っています。

以下は元のコードです。誰かが助けることができれば感謝します。

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

、少なくとも2つの潜在的な問題がここにありますmailitem

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

ののHtmlBodyプロパティを使用します。

wdMailFormatHTMLパラメータは、フルバージョンのOutlook、Outlook Expressなどでは機能しません。つまり、Outlookは、これが動作するには関連するシステムのデフォルトの電子メールクライアントでなければなりません。 （他の電子メールクライアントは明らかにHTML電子メールを "行う"ということは、HTML電子メールを送信するためにWordが使用するメカニズムで動作することは知られていないということです）。

あなたOutlookを使用してあると仮定すると、第二の問題は、電子メールのマージ処理がちょうどへのマージのデータソースであるEmailDataSource.docのデータ列に配置されたテキストを、電子メールで送信されていることですEメール。現在EmailMergeTableMakerルーチンが動作する方法は、タブ区切りのテキストブロックになります。 Wordはおそらくタブをいくつかの空白に展開しますが、HTMLテーブルは生成されません。だからおそらくアラインメントの問題の原因です。その場合は、各セルに代わりに表が含まれていることを確認する必要があります。

EmailMergeTableMakerの仕組みを再考することで、これを実行する方がいいでしょう。次の「クイックフィックス」はここのサンプルデータで動作しましたが、たとえばセルが空の状況をテストしませんでした。このコードの後

...

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を使用してないている場合、あなたは差し込み印刷を使用することはできません直接を使ってHTML形式のメッセージを作成することはできますが、Outlookオブジェクトモデルを使用してそれを行うことはできないため、HTML形式の電子メールを生成して送信する必要があると思います他の方法（例： SMTPを介して直接）、それはまったく別の話です。

Outlookを介して電子メールを送信するもう1つの方法は、Thomas Inzinaが示唆するように、Outlookを自動化することです。ただし、マージの仕方に他の変更を加える必要があります。

FWIWあなたが使用しているルーチンは "macropod"という言葉に由来しています - 私はそのリンクを持っていませんが、 "macropod Catalog MailMerge Tutorial"の検索でこれを解決する他の方法問題のタイプ。