У меня есть пользовательская форма с рядом переключателей, каждая из которых представляет свой вариант отчета, в моей пользовательской форме. Когда пользователь выбирает один (или несколько) отчетов, нажимая кнопку, связанную с этим отчетом, запрос отчета помещается в сигнал, для которого код будет циклически обрабатывать каждый из них.
В цикле слияние почты 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