1

我正在运行 Office 2013。我的 Access 数据库有许多通过 ODBC 链接到 Oracle 数据库的表。我有一个 Access 模块，它执行参数查询，将结果导出到 Excel 电子表格，并打开一个现有的 Word 合并字母，并将电子表格集作为合并数据源。此外，为了在我自己之后进行清理并避免潜在的多用户冲突，每次创建电子表格时都会为其分配一个唯一名称，并在合并完成后将其删除。每次运行此过程都会成功运行但每次运行时都会收到来自 Word 的许多提示，我不知道如何以编程方式处理这些提示，因此用户每次运行此模块时都不必单击这些提示. 这就是我需要帮助的地方。

这是我的代码（对不起，如果太长，第一次发帖）。代码后面列出了我需要解决的提示：

Option Compare Database
Option Explicit

Private Const sPath = "\\MyNetworkPath\Development\"       'development path
'Private Const sPath = "\\MyNetworkPath\"                  'production path

Public Sub RunMailMerge(dataFile As String, mergeFile As String)
On Error GoTo Sub_Error

    Dim sMergeFile As String
    Dim sDataFile As String
    Dim objWordDoc As Word.Document

    sDataFile = dataFile
    sMergeFile = mergeFile

    On Error GoTo Sub_Error
    Set objWordDoc = GetObject(sMergeFile, "Word.Document")

    objWordDoc.Application.Visible = True

    objWordDoc.MailMerge.OpenDataSource _
        Name:=sDataFile, ConfirmConversions:=False, _
        ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
        Connection:="", SQLStatement:="", SQLStatement1:=""

    objWordDoc.MailMerge.Destination = wdSendToNewDocument

    objWordDoc.MailMerge.Execute

Sub_Exit:
On Error Resume Next
    ' save and close the merge template
    objWordDoc.Save
    objWordDoc.Close SaveChanges:=wdSaveChanges
    Set objWordDoc = Nothing
    ' clean up the merge data file
    AttemptToDeleteFile (sDataFile)

    Exit Sub

Sub_Error:
    If Err.Number = 432 Then
        MsgBox "ERROR: Invalid filename provided: '" & sDataFile & "' or " & _
        "'" & sMergeFile & "'."
    Else
        MsgBox Err.Description
    End If

    Resume Sub_Exit

End Sub

'attempt to delete the mailmerge data file
Private Sub AttemptToDeleteFile(strFilename As String)
On Error GoTo Sub_Error

    Kill strFilename

Sub_Exit:
    Exit Sub

Sub_Error:
    If Err.Number = 53 Then 'err 53 = file not found, that means the file is already deleted!
        'no error, continue
        Resume Sub_Exit
    ElseIf MsgBox("Cannot delete file.  Close all Word mailmerge documents and click Retry.", vbRetryCancel + vbExclamation, "File In Use") = vbRetry Then
        Resume
    Else
        On Error GoTo 0
        Err.Raise vbObjectError + 1024 + 1, "file in use", "File In Use@" & _
                    "Cannot complete the mailmerge process because the file '" & strFilename & "' " & _
                    "is in use.  Close all Word mailmerge documents and try again."
    End If

End Sub

Function OpenProjectAknowledgementLetter()
On Error GoTo OpenProjectAknowledgementLetter_Err

    Dim sDataFile As String
    Dim sMergeFile As String

    sDataFile = sPath & "Acknowledgement\ProjAckgtLtr_" & Format(Now(), "yyyymmddhhnnss") & ".xls"
    sMergeFile = sPath & "Acknowledgement\Acknowledgement_Merge_Letter.docx"

    Debug.Print "Data file: " & sDataFile
    'Debug.Print "Merge file: " & sMergeFile

    ' run the query and populate the data file for the merge letter
    DoCmd.OutputTo acOutputQuery, "qselProjectAknowledgementLetter", "Excel97-Excel2003Workbook(*.xls)", sDataFile, False, "", , acExportQualityPrint

    Call RunMailMerge(sDataFile, sMergeFile)

OpenProjectAknowledgementLetter_Exit:
    Exit Function

OpenProjectAknowledgementLetter_Err:
    MsgBox Error$
    Resume OpenProjectAknowledgementLetter_Exit

End Function

需要处理的单词提示：

打开此文档将运行以下 SQL 命令：[select 语句]。您数据库中的数据将被放置在文档中。你想继续吗？是/否

选择 Yes 会产生以下消息：

抱歉，我们找不到 [以前使用的数据源文件名]。它是否可能被移动、重命名或删除？好的

单击确定会生成一个文件打开对话框以选择数据源。单击此对话框上的取消返回到合并文档，然后显示选择表提示并选择工作表名称。

在此提示上单击“确定”允许代码模块继续进行，而无需进一步提示。信件被合并到新文档，合并文档被保存并关闭，数据源文件被删除。

很明显，Word 正在接受新分配的数据源文件并成功完成合并。如何告诉 Word 跳过所有这些提示并继续使用它？

4

0 回答 0