Question

我正在运行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

Word提示需要处理：

打开此文档将运行以下SQL命令：[select 声明]。来自您数据库的数据将放在文档中。做你想继续吗？是/否

选择是会产生以下消息：

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

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

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

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

使用访问vba响应或禁止单词邮件合并提示

0 个答案: