在 Access 中创建一个按钮以打开 Word 文档

Question

我有一个使用邮件合并功能并从访问数据库获取信息的 word 文档。当我使用此代码时，它不会打开包含当前信息的 word 文档。它会打开带有上次保存信息的 word 文档。

如果我自己打开 word 文档，从任务栏中，它会询问我是否要运行 SQL，然后单击“是”，一切正常。我想从访问权限中单击一个按钮来完成打开合同的相同任务。

这是我使用的代码：

Private Sub Command205_Click()

Dim LWordDoc As String
Dim oApp As Object

'Path to the word document
LWordDoc = "C:\Users\.....k Up\01- Proposal\contract.docx"

If Dir(LWordDoc) = "" Then
  MsgBox "Document not found."

Else
  'Create an instance of MS Word
  Set oApp = CreateObject(Class:="Word.Application")
  oApp.Visible = True

  'Open the Document
  oApp.Documents.Open FileName:=LWordDoc
End If

End Sub

***我应该补充一点，我不是编码员，对 VBA 一无所知，我从这个网站复制了这个，所以你能提供的任何帮助将不胜感激。如果您可以为我提供编码或足够的指导以帮助我上路，那就太好了。谢谢你

Answer 1

此代码将在 Access 中运行以打开邮件合并文档并更新内容并保存。

使用我最初发布的链接 (http://www.minnesotaithub.com/2015/11/automatic-mail-merge-with-vba-and-access/)，我进行了一些修改，并且能够使该代码正常工作。

我需要添加：ReadOnly:=True, _ 以防止共享冲突 我更改了源数据的表名。

注意！！您将需要更改标有“###”的 sode，如下所示：

###-1 更改以指定模板的完整路径！！！

###-2 更改 SQLSTATEMENT 以指定您的记录源！！！

将此代码粘贴到您的表单中，确保您有一个可以执行的命令按钮单击事件（在此代码中重命名“Command205”，或更改您的控件名称）。

Option Compare Database
Option Explicit

Private Sub Command205_Click()
Dim strWordDoc  As String

    'Path to the word document of the Mail Merge
    '###-1 CHANGE THE FOLLOWING LINE TO POINT TO YOUR DOCUMENT!!
    strWordDoc = "C:\Users\.....k Up\01- Proposal\contract.docx"

    ' Call the code to merge the latest info
    startMerge strWordDoc

End Sub


'----------------------------------------------------
' Auto Mail Merge With VBA and Access (Early Binding)
'----------------------------------------------------
' NOTE: To use this code, you must reference
' The Microsoft Word 14.0 (or current version)
' Object Library by clicking menu Tools > References
' Check the box for:
' Microsoft Word 14.0 Object Library in Word 2010
' Microsoft Word 15.0 Object Library in Word 2013
' Click OK
'----------------------------------------------------
Function startMerge(strDocPath As String)
    Dim oWord           As Word.Application
    Dim oWdoc           As Word.Document
    Dim wdInputName     As String
    Dim wdOutputName    As String
    Dim outFileName     As String

    ' Set Template Path
    wdInputName = strDocPath            ' was CurrentProject.Path & "\mail_merge.docx"

    ' Create unique save filename with minutes and seconds to prevent overwrite
    outFileName = "MailMergeFile_" & Format(Now(), "yyyymmddmms")

    ' Output File Path w/outFileName
    wdOutputName = CurrentProject.Path & "\" & outFileName

    Set oWord = New Word.Application
    Set oWdoc = oWord.Documents.Open(wdInputName)

    ' Start mail merge

    '###-2 CHANGE THE SQLSTATEMENT AS NEEDED
    With oWdoc.MailMerge
        .MainDocumentType = wdFormLetters
        .OpenDataSource _
            Name:=CurrentProject.FullName, _
            ReadOnly:=True, _
            AddToRecentFiles:=False, _
            LinkToSource:=True, _
            Connection:="QUERY mailmerge", _
            SQLStatement:="SELECT * FROM [tblEmployee]"         ' Change the table name or your query
        .Destination = wdSendToNewDocument
        .Execute Pause:=False
    End With

    ' Hide Word During Merge
    oWord.Visible = False

    ' Save file as PDF
    ' Uncomment the line below and comment out
    ' the line below "Save file as Word Document"
    '------------------------------------------------
    'oWord.ActiveDocument.SaveAs2 wdOutputName & ".pdf", 17

    ' Save file as Word Document
    ' ###-3 IF YOU DON'T WANT TO SAVE AS A NEW NAME, COMMENT OUT NEXT LINE
    oWord.ActiveDocument.SaveAs2 wdOutputName & ".docx", 16

    ' SHOW THE DOCUMENT
    oWord.Visible = True

    ' Close the template file
    If oWord.Documents(1).FullName = strDocPath Then
        oWord.Documents(1).Close savechanges:=False
    ElseIf oWord.Documents(2).FullName = strDocPath Then
        oWord.Documents(2).Close savechanges:=False
    Else
        MsgBox "Well, this should never happen! Only expected two documents to be open"
    End If

    ' Quit Word to Save Memory
    'oWord.Quit savechanges:=False

    ' Clean up memory
    '------------------------------------------------
    Set oWord = Nothing
    Set oWdoc = Nothing

End Function