我的用户窗体中有一个带有一系列切换按钮的用户窗体,每个按钮代表一个不同的报告选项。当用户通过按该报告的关联按钮选择一个(或多个)报告时,该报告查询将放入一个提示中,代码将循环进行处理每个提示。 在循环中,将对该特定报告执行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
答案 0 :(得分:0)
问题在于您正在创建一个新的Word会话来生成文档,但是您永远不会关闭它们或退出新的Word会话,而在文档仍处于打开状态的情况下将其孤立在后台。