为什么我的VB邮件不能从Access实际发送电子邮件?

时间:2017-12-07 11:42:04

标签: vb.net email ms-access ms-word mailmerge

我希望通过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

感激不尽的任何帮助

0 个答案:

没有答案