编辑后关闭嵌入对象

时间:2013-02-15 11:56:20

标签: excel-vba ms-word mailmerge quit vba

使用嵌入式Word文件执行邮件合并时遇到问题。基本上

我正在尝试构建一个宏:

  • 打开一个嵌入的Word文件(假设该文件是Object(2))
  • 将导出工作表连接到单词fie
  • 预览结果
  • 更新目录
  • 将文件导出为PDF
  • 关闭应用程序一词,打开已完成的PDF

这是我到目前为止的代码,但之后不会关闭WINWORD应用程序:

Public Sub fExportSVF()

    Dim WdObj As Object
    Dim WdApp As Word.Application
    Dim WdDoc As Word.Document
    Dim intIndex As Integer
    Dim strPeril As String
    Dim strClaimNumber As String
    Dim strPHName As String
    Dim strSaveLoc As String
    Dim strWbName As String
    Dim strTempLoc As String
    Dim xlObj As Object

    Application.ScreenUpdating = False

    Call fUnhideSheet("EXPORT_DATA")

    Application.DisplayAlerts = False
    ThisWorkbook.Save
    Application.DisplayAlerts = True

    strTempLoc = Environ("TEMP") & Int((9999 - 1 + 1) * Rnd + 1) & ".xlsm"

    strWbName = Worksheets("Settings").Range("B4").Value
    strPeril = Worksheets("Settings").Range("B3").Value
    strClaimNumber = Worksheets("Settings").Range("B1").Value
    strPHName = Worksheets("Settings").Range("B2").Value

    If Dir(strTempLoc) <> "" Then Kill strTempLoc

    Set xlObj = CreateObject("Scripting.FileSystemObject")

    xlObj.CopyFile ThisWorkbook.FullName, strTempLoc, True

    strSaveLoc = ActiveWorkbook.Path & "\" & strClaimNumber & _
    " - " & strPHName & " - " & strPeril & ".pdf"

    Select Case strPeril
        Case "Acc"
            intIndex = 2
        Case "Acci"
            intIndex = 3
        Case "AD"
            intIndex = 4
        Case "Es"
            intIndex = 5
        Case "Fi"
            intIndex = 6
        Case "Fld"
            intIndex = 7
        Case "Impt"
            intIndex = 8
        Case "St"
            intIndex = 9
        Case "Th"
            intIndex = 10
    End Select

    Set WdObj = Worksheets("Settings").OLEObjects(intIndex)

    WdObj.Activate
    WdObj.Object.Application.Visible = False

    Set WdApp = GetObject(, "Word.Application")
    Set WdDoc = WdApp.ActiveDocument

    WdApp.Visible = True

    WdDoc.MailMerge.MainDocumentType = wdFormLetters

    WdDoc.MailMerge.OpenDataSource Name:= _
        strWbName _
        , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & strTempLoc & _
        ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet " & _
        "OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine " _
        , SQLStatement:="SELECT * FROM `EXPORT_DATA$`", SQLStatement1:="", _
        SubType:=wdMergeSubTypeAccess
    WdDoc.MailMerge.ViewMailMergeFieldCodes = wdToggle

    WdDoc.TablesOfContents(1).Update

    WdDoc.ExportAsFixedFormat outputfilename:=strSaveLoc, _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False

    WdApp.ActiveDocument.Close wdDoNotSaveChanges

    Set WdApp = Nothing
    Set WdObj = Nothing

    Kill strTempLoc

    Call fHideSheet("EXPORT_DATA")

    Application.ScreenUpdating = True

End Sub

除了关闭WINWORD应用程序之外,它还可以执行所有操作。除此之外,我注意到如果有另一个文件已经打开,那么它也会变得不可见。

请帮忙吗?

干杯

编辑:此外,运行此代码的计算机上将同时包含Word 97和Word 2007。该文档需要在Word 2007中打开和编辑。谢谢

1 个答案:

答案 0 :(得分:0)

更改此行(将WdApp设置为现有的Word实例,如果有):

Set WdApp = GetObject(, "Word.Application")

这将创建一个新的Word实例,以防止关闭其他可能打开的文档:

Set WdApp = CreateObject("Word.Application")

要关闭wdApp,请使用Quit方法:

wdApp.Quit