-1
私はパーソナライズされたメッセージを働かせようとしています。テキストの書式（太字、イタリック、...）を維持しながら、絵やテキストを送信するのが難しいです。メールは、パーソナライズされた添付ファイルとメッセージ（画像とテキスト）で電子メールにマージされます
同様の問題（Preserve text format when sending the content of a word document as the body of an email,）に関して、このウェブサイト上の関連する問題を読みました。それは私が始めるのを助けた。
コード私が使用しています：
Sub emailmergewithattachments_2()
Dim Source As Document, Maillist As Document, wdDoc As Document
Dim Datarange As Range
Dim wdRange As Range
Dim i As Long, j As Long
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim Insp As Outlook.Inspector
Dim MySubject As String, Message As String, Title As String
'The source document is Word document that contains the personnalised
'letters sent to the recipients
Set Source = ActiveDocument
' Check if Outlook is running. If it is not, start Outlook
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
' Open the catalog mailmerge document
With Dialogs(wdDialogFileOpen)
.Show
End With
'The Maillist is a 2 column table containing the email adress and the second column
'contains the path and the name of the file to be joined with the email
Set Maillist = ActiveDocument
' Show an input box asking the user for the subject to be inserted into the email messages
Message = "Enter the subject to be used for each email message." ' Set prompt.
Title = " Email Subject Input" ' Set title.
' Display message, title
MySubject = InputBox(Message, Title)
' Iterate through the Sections of the Source document and the rows of the catalog mailmerge document,
' extracting the information to be included in each email.
For j = 1 To Source.Sections.Count - 1
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
.Subject = MySubject 'subject line
'reading the first column of the maillist (the email)
Set Datarange = Maillist.Tables(1).Cell(j, 1).Range
Datarange.End = Datarange.End - 1
.To = Datarange 'recipient's email
'joining the personalised attachements to each recipient
For i = 2 To Maillist.Tables(1).Columns.Count
Set Datarange = Maillist.Tables(1).Cell(j, i).Range
Datarange.End = Datarange.End - 1
.Attachments.Add Trim(Datarange.Text), olByValue, 1
Next i
'Obtain the Inspector for this Email
Set Insp = oItem.GetInspector
'Obtain the Word document for the Inspector
Set wdDoc = Insp.WordEditor
'Use the Range object to insert text
Set wdRange = wdDoc.Range(0, wdDoc.Characters.Count)
wdRange.InsertAfter ("Text inserted") 'for testing only (to check if it really working)
'Word document containing the text and the images
Windows("lettres.docx").Activate
Selection.WholeStory
'*******************************************************************************
'Problematic part: trying to paste the selection into wdDoc while preserving the formatting
'and the entire content of the document of the file "lettres.docx"
'...missing code
'********************************************************************************
.Send
End With
Set oItem = Nothing
Next j
Maillist.Close wdDoNotSaveChanges
' Close Outlook if it was started by this macro.
If bStarted Then
oOutlookApp.Quit
End If
MsgBox Source.Sections.Count - 1 & " messages have been sent."
'Clean up
Set oOutlookApp = Nothing
End Sub
文書を共有できますか？ – 0m3r
Om3r、これは文書化されていますか？ lettres.docx、SourceまたはMaillist？ ** lettres.docx **はそこにあるべきではありません（テスト目的のみ）実際には、各電子メールの本文にコピーしたいコンテンツを含むWord文書は、通常の文字を表すSource変数に割り当てられた文書です差し込み印刷を使用して印刷します。そのドキュメントには何も特別なものはありません。名前とアドレスのテキスト、グラフィックス、マージフィールドです。 MailItemオブジェクトのBodyプロパティは、書式設定なしのテキストのみを保持します。グラフィックス、アドレス、名前のないメールを送信することはプロフェッショナルではありません。 – Pierre
@ Om3r、私はこのアドレスでオンラインで見つかったスクリプトを修正しようとしています[link] https://www.maxwell.syr.edu/uploadedFiles/ict/Training/Handouts/Handout%20-%20EmailMergeWithAttachment(1） .pdf。 – Pierre