由Excel宏创建的邮件合并文档不能由Excel发布吗?

时间:2019-05-31 10:51:49

标签: excel vba ms-word

我的用户窗体中有一个带有一系列切换按钮的用户窗体,每个按钮代表一个不同的报告选项。当用户通过按该报告的关联按钮选择一个(或多个)报告时,该报告查询将放入一个提示中,代码将循环进行处理每个提示。 在循环中,将对该特定报告执行Word邮件合并。执行邮件合并,创建文档,然后保存。这些新创建的Word文档保持打开状态。偏好是用户通过单击与用户表单中特定报告相对应的先前按下的切换按钮来关闭这些Word文档。看来工作正常。

现在,用户可以在创建这些文档后(并且在关闭之前)访问这些文档,并进行编辑和打印。它们可以正常打印,但是无法保存任何更改。用户可以单击打开的Word文档菜单中的“保存”图标,直到鼠标电池没电并且没有任何保存。但是,如果您返回到Excel,请在工作表上单击,然后返回到Word文档,则可以保存它。 (几乎就像这样做打破了两个文档之间的束缚)

如果用户从关闭状态(即从目录)保存位置访问这些Word文档,则它们将打开并可以进行编辑,但又不能保存。只要Excel对创建文档的应用程序是开放的即可。编辑:情况并非如此。即使关闭EXCEL,这些预先创建的邮件合并文档也可以编辑,但可以编辑。由于文件权限错误而无法重新保存。

我发现的是,如果我的Excel应用程序已关闭,则由于文件权限错误,这些文件不再显示出保存困难。看起来,一旦Excel启动并生成了这些报告,它就会带有一些“锁定”。只要用于生成它们的Excel应用程序处于打开状态,这些文件似乎就不会从Excel生成代码中完全释放。

Sub merge2(ByVal i As Long, ByVal rpt_od As String, objWord As Object, ByVal dest As Long)

    Dim oDoc As Object, oDoc2 As Object
    Dim StrSQL As String, fName As String, StrSrc As String, strFilename As String, myPath As String
    Dim qfile As String, st_srchfn As String, wb_qfile2 As Workbook, itype As String, isubresp As String
    'Dim wb_qfile2 As Workbook
    Dim HdFt As Variant
    Dim wdSendToNewDocument

    Const wdSendtToNewDocument = 0
    Const wdSendToPrinter = 1
    Const wdFormLetters = 0
    Const wdDirectory = 3
    Const wdMergeSubTypeAccess = 1
    Const wdOpenFormatAuto = 0

    work_fn = ws_vh.Range("N2")
    Set wb_nwb = Workbooks(work_fn)

    'create workorders folder
    myPath = "u:\fff\ffff\ffffffffffff\fffff\fffff\WORKORDERS\" & format(ws_vh.Range("B17"), "ddd dd-mmm-yy")
    If Dir(myPath, vbDirectory) = "" Then 'if not already created ...
        MkDir myPath
    End If

    'close data file
    st_srchfn = "u:\u:\fff\ffff\ffffffffffff\fffff\fffff\DATA\" & ws_vh.Range("N2")
    If wb_nwb Is Nothing Then
        MsgBox wb_nwb & " is NOT open."
    Else
        wb_nwb.Close True 'saves data workbook after TYPE was updated for GS
        With ws_base
            .Range("B24:D24").Value = ws_vh.Range("A57:C57").Value
        End With
    End If

    itype = Right(ws_th.Range("A" & i), 2)
    isubresp = Left(ws_th.Range("A" & i), 3)

    If itype = "DR" Then
        fName = "u:\fff\ffff\ffffffffffff\fffff\fffff\REPORTS\NG\DR15NG.docx"
    ElseIf itype = "DT" Then
        fName = "u:\fff\ffff\ffffffffffff\fffff\fffff\REPORTS\NG\DT15NG.docx"
    ElseIf itype = "FR" Then
        fName = "u:\fff\ffff\ffffffffffff\fffff\fffff\REPORTS\NG\FR15NG.docx"
    ElseIf itype = "FT" Then
        fName = "u:\fff\ffff\ffffffffffff\fffff\fffff\REPORTS\NG\FT15NG.docx"
    ElseIf itype = "CR" Then
        fName = "u:\fff\ffff\ffffffffffff\fffff\fffff\REPORTS\NG\CR15NG.docx"
    ElseIf itype = "CT" Then
        fName = "u:\fff\ffff\ffffffffffff\fffff\fffff\REPORTS\NG\CT15NG.docx"
    ElseIf itype = "GS" Then
        If isubresp = "HPE" Or isubresp = "HPL" Then
            fName = "u:\fff\ffff\ffffffffffff\fffff\fffff\REPORTS\NG\GS15NG_GSH.docx" 'Passive : Hillside
        Else
            fName = "u:\fff\ffff\ffffffffffff\fffff\fffff\REPORTS\NG\GS15NG_GS.docx" 'Passive : Wloo Park
        End If
    Else
        fName = "u:\fff\ffff\ffffffffffff\fffff\fffff\REPORTS\NG\GS15NG_GM.docx"
    End If

    StrSrc = "u:\fff\ffff\ffffffffffff\fffff\fffff\DATA\" & ws_vh.Range("N2")

    StrSQL = "SELECT * FROM [DATA$] WHERE [TYPE]='" & itype & "' AND [SIG_CREW]='" & isubresp & "' " & _
        "ORDER BY [STARTS] ASC, [COMPLEX] ASC, [UNIT] ASC"

    Set objWord = CreateObject("Word.Application")
    With objWord
        .DisplayAlerts = False
        .Visible = True
        Set oDoc = .Documents.Open(Filename:=fName, ConfirmConversions:=False, _
            ReadOnly:=True, AddToRecentFiles:=False, Visible:=True)
        With oDoc
            With .MailMerge
                .MainDocumentType = wdFormLetters
                .Destination = wdSendToNewDocument
                .SuppressBlankLines = True
                .OpenDataSource Name:=StrSrc, AddToRecentFiles:=False, LinkToSource:=False, ConfirmConversions:=False, _
                    ReadOnly:=True, format:=wdOpenFormatAuto, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "User ID=Admin;Data Source=" & StrSrc & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";", _
                    SQLStatement:=StrSQL, SQLStatement1:="", SubType:=wdMergeSubTypeAccess
                .Execute Pause:=False
            End With
            .Close False
        End With
        .DisplayAlerts = True

        'page break routine only for sports reports
        If (Left(itype, 1) <> "G") And (itype <> "DT") Then   'exclude GS reports
            With .activedocument
                If .Sections.count > 1 Then
                    For Each HdFt In .Sections(.Sections.count).Headers
                        If HdFt.Exists Then
                            HdFt.Range.FormattedText = .Sections(1).Headers(HdFt.index).Range.FormattedText
                            HdFt.Range.Characters.Last.Delete
                        End If
                    Next
                    For Each HdFt In .Sections(.Sections.count).Footers
                        If HdFt.Exists Then
                            HdFt.Range.FormattedText = .Sections(1).Footers(HdFt.index).Range.FormattedText
                            HdFt.Range.Characters.Last.Delete
                        End If
                    Next
                End If
                Do While .Sections.count > 1
                    .Sections(1).Range.Characters.Last.Delete
                    DoEvents
                Loop
                .Range.Characters.Last.Delete
            End With
        End If

    End With

    Set oDoc2 = objWord.activedocument

    'save newly created document
    With oDoc2
        myPath = "u:\fff\ffff\ffffffffffff\fffff\fffff\WORKORDERS\" & format(ws_vh.Range("B17"), "ddd dd-mmm-yy")
        .SaveAs myPath & "\" & rpt_od & ".docx"
        If dest = 2 Then
            .PrintOut
        End If
        '.Close
    End With


    Set oDoc = Nothing: Set oDoc2 = Nothing ': Set objWord = Nothing

End Sub

1 个答案:

答案 0 :(得分:0)

问题在于您正在创建一个新的Word会话来生成文档,但是您永远不会关闭它们或退出新的Word会话,而在文档仍处于打开状态的情况下将其孤立在后台。