代码之家 › 专栏 › 技术社区 › Gregor

由VBA在Access中启动的邮件合并让Word再次打开数据库

mailmerge access-vba ms-access

4

Gregor · 技术社区 · 15 年前

我正在开发一个Access数据库,它生成一些邮件合并,邮件合并是从Access数据库中的VBA代码调用的。问题是,如果我打开一个新的Word文档并启动邮件合并(VBA),Word会打开同一个Access数据库(已经打开)来获取数据。有什么方法可以防止这种情况发生吗?是否使用已打开的数据库实例?

经过一些测试,我得到了一个奇怪的行为:如果我用SHIFT键打开Access数据库,邮件合并就不会打开同一数据库的其他访问实例。如果我在不持有密钥的情况下打开Access数据库,就会得到所描述的行为。

我的邮件合并VBA代码:

On Error GoTo ErrorHandler

    Dim word As word.Application
    Dim Form As word.Document

    Set word = CreateObject("Word.Application")
    Set Form = word.Documents.Open("tpl.doc")

    With word
        word.Visible = True

        With .ActiveDocument.MailMerge
            .MainDocumentType = wdMailingLabels
            .OpenDataSource Name:= CurrentProject.FullName, ConfirmConversions:=False, _
                ReadOnly:=False, LinkToSource:=False, AddToRecentFiles:=False, _
                PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
                WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
                SQLStatement:="[MY QUERY]", _
                SQLStatement1:="", _
                SubType:=wdMergeSubTypeWord2000, OpenExclusive:=False
            .Destination = wdSendToNewDocument
            .Execute
            .MainDocumentType = wdNotAMergeDocument
        End With
    End With

    Form.Close False
    Set Form = Nothing

    Set word = Nothing

Exit_Error:
    Exit Sub
ErrorHandler:
    word.Quit (False)
    Set word = Nothing
    ' ...
End Sub

整个过程都是通过access/word 2003完成的。

更新第1号 如果有人能告诉我使用或不使用SHIFT键打开访问的确切区别,这也会有所帮助。如果可以编写一些VBA代码来启用“功能”,那么如果数据库在没有shift键的情况下打开,它至少会“模拟”它。

干杯, 格雷戈

1 回复 | 直到 9 年前

1

8

awrigley 15 年前

    Public Function MailMergeLetters() 
           Dim pathMergeTemplate As String
            Dim sql As String
            Dim sqlWhere As String
            Dim sqlOrderBy As String


'Get the word template from the Letters folder  

            pathMergeTemplate = "C:\MyApp\Resources\Letters\"

'This is a sort of "base" query that holds all the mailmerge fields
'Ie, it defines what fields will be merged.

            sql = "SELECT * FROM MailMergeExportQry" 

            With Forms("MyContactsForm")

' Filter and order the records you want
'Very much to do for you

            sqlWhere = GetWhereClause()
            sqlOrderBy = GetOrderByClause()

            End With

' Build the sql string you will use with this mail merge

            sql = sql & sqlWhere & sqlOrderBy & ";"

'Create a temporary QueryDef to hold the query

                Dim qd As DAO.QueryDef
                Set qd = New DAO.QueryDef
                    qd.sql = sql
                    qd.Name = "mmexport"

                    CurrentDb.QueryDefs.Append qd

' Export the data using TransferText

                        DoCmd.TransferText _
                            acExportDelim, , _
                            "mmexport", _
                            pathMergeTemplate & "qryMailMerge.txt", _
                            True
' Clear up
                    CurrentDb.QueryDefs.Delete "mmexport"

                    qd.Close
                Set qd = Nothing

'------------------------------------------------------------------------------
'End Code Block:
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'Start Code Block:
'OK. Access has built the .txt file.
'Now the Mail merge doc gets opened...
'------------------------------------------------------------------------------

                Dim appWord As Object
                Dim docWord As Object

                Set appWord = CreateObject("Word.Application")

                    appWord.Application.Visible = True

' Open the template in the Resources\Letters folder:

                    Set docWord = appWord.Documents.Add(Template:=pathMergeTemplate & "MergeLetters.dot")

'Now I can mail merge without involving currentproject of my Access app

                        docWord.MailMerge.OpenDataSource Name:=pathMergeTemplate & "qryMailMerge.txt", LinkToSource:=False

                    Set docWord = Nothing

                Set appWord = Nothing

'------------------------------------------------------------------------------
'End Code Block:
'------------------------------------------------------------------------------

        Finally:
            Exit Function

        Hell:
            MsgBox Err.Description & " " & Err.Number, vbExclamation, APPHELP

        On Error Resume Next
            CurrentDb.QueryDefs.Delete "mmexport"

            qd.Close
            Set qd = Nothing

            Set docWord = Nothing
            Set appWord = Nothing

            Resume Finally

        End Function

sqlWhere = GetWhereClause()
sqlOrderBy = GetOrderByClause