使用嵌入式Word文件执行邮件合并时遇到问题。基本上
我正在尝试构建一个宏:
这是我到目前为止的代码,但之后不会关闭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中打开和编辑。谢谢
答案 0 :(得分:0)
更改此行(将WdApp设置为现有的Word实例,如果有):
Set WdApp = GetObject(, "Word.Application")
这将创建一个新的Word实例,以防止关闭其他可能打开的文档:
Set WdApp = CreateObject("Word.Application")
要关闭wdApp
,请使用Quit方法:
wdApp.Quit