Документы, слитые по почте, созданные в макросе Excel, не выпускаемые Excel? - PullRequest
0 голосов
/ 31 мая 2019

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

Проблема заключается в том, что вы создаете новый сеанс Word для генерации документов, но вы никогда не закрываете их и не выходите из нового сеанса Word, оставляя его сиротой в фоновом режиме с открытым документом.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...