我希望通过Access查询和预先设置word doc发送邮件合并和电子邮件。它似乎工作正常,因为合并的数据文档与我(现在)保存的新合并文档一起出现。 但我真正希望它做的是发送实际的电子邮件,而不是手动转到'完成&合并“来自MsWord。只是它实际上并没有发送电子邮件。
Function runMerge()
Dim StrFullDocPath As String
Dim oApp As Object
'Path to the word document
StrFullDocPath = "merge.docx" 'have removed the full path
'to save file name
outFileName = "Renewals_" & Format(Now(), "dd-mm-yyyy")
If Dir(StrFullDocPath) = "" Then
MsgBox "Document not found"
Else
'Create an instance of MS Word
Set oApp = CreateObject("Word.Application")
oApp.Visible = True
'Open the Document
oApp.Documents.Open FileName:=StrFullDocPath
End If
With oApp
With .ActiveDocument.MailMerge
.MainDocumentType = wdEMail
.OpenDataSource _
Name:="myDB.accdb", _
LinkToSource:=True, _
AddToRecentFiles:=False, _
Connection:="QUERY qryCheckRenews", _
SQLStatement:="SELECT * FROM [qryCheckRenews]"
.Destination = wdSendToEmail
.MailAddressFieldName = "EmailAddress"
.MailFormat = wdMailFormatHTML
.MailAsAttachment = False
.MailSubject = "testing testing 1, 2, 3"
.SuppressBlankLines = True
.Execute Pause:=False
MsgBox "Mail Merge Complete ", vbOKOnly, "myDB"
End With
oApp.ActiveDocument.SaveAs2 FileName:="Renewal" & outFileName & ".docx"
'oApp.Documents.Close savechanges:=False
Set oApp = Nothing
End With
'Exit Sub
'ErrTrap:
' MsgBox Err.Description, vbCritical
End Function
感激不尽的任何帮助