Excel VBA修改带书签的Word文档

Question

I have a problem with my code below. I created an userform in order to generate Word documents automatically which I prepared (I created a bunch of bookmarks).

It works really well on my computer but not on another computer and I really don't understand why. Both computers have the same Office version (1902) and I have activated the Microsoft Word 16.0 Object Library reference.

What I mean by "it's not working" it is that the Word document will open but no action will be Performed... And also I have not a single error message.

    Private Sub BCO_Click()

        Dim objWord As New Word.Application, wordDoc As Word.Document

'FCO is the userform and the subobjects are combobox entries.
        If FCO.SOCIETENAME <> "" And FCO.NUMCO <> "" And FCO.ComboBox1 <> "" Then

            Dim pathcovierge As String
            Dim pathconew As String

'Path of the files needed there, copy from an existing (pathcovierge) to a new one (pathconex)
            pathcovierge = path & "\Documents_Vierges\" & "CO.docx"
            pathconew = path & "\CO\CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx"

            If Dir(path & "\CO\", vbDirectory) = "" Then MkDir path & "\CO\"

'If file already open, msgbox
            On Error Resume Next

            FileCopy pathcovierge, pathconew

            If Err > 0 Then
                MsgBox "Veuillez fermer CO.docx afin de générer un CO."
            End If



'opening of the new word document

            objWord.Visible = True
            objWord.Documents.Open pathconew

            Dim DocDest As Word.Document
            Set DocDest = GetObject(pathconew)


'THIS IS NOT WORKING.

            DocDest.Bookmarks("WNUMCO").Range.Text = FCO.NUMCO.Value
            DocDest.Bookmarks("WDATECO").Range.Text = FCO.DATECO.Value
            DocDest.Bookmarks("WNOMCLIENT").Range.Text = FCO.SOCIETENAME.Value



'Saving (working)
            DocDest.SaveAs pathconew
            AppActivate ("CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx")

            On Error GoTo 0
        Else
            MsgBox "Veuillez rentrer tous les champs obligatoires (*)"
        End If


    End Sub

Answer 1

I took a look in your code and made some changes (also see my comments in the code):

• I enhanced the readability by early exiting the procedure instead of using 'arrow code'.
• Now the opened Word document will be set to the variable immediately.
• Your error handling suppressed all errors. I changed it, but you should add proper error handling though. Think about splitting your procedure in several separate procedures.

This should lead you to your result:

Private Sub BCO_Click()
    If FCO.SOCIETENAME = "" Or FCO.NUMCO = "" Or FCO.ComboBox1 = "" Then
        MsgBox "Veuillez rentrer tous les champs obligatoires (*)"
        Exit Sub
    End If

    Dim pathcovierge As String
    pathcovierge = path & "\Documents_Vierges\" & "CO.docx"

    Dim pathconew As String
    pathconew = path & "\CO\CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx"

    If Dir(path & "\CO\", vbDirectory) = "" Then MkDir path & "\CO\"

    'This seems to be the reason why you get no error:
    On Error Resume Next

    FileCopy pathcovierge, pathconew

    If Err > 0 Then
        MsgBox "Veuillez fermer CO.docx afin de générer un CO."
    End If

    'This will let you see a possible error, but you should think about implement a proper error handling though:
    On Error Goto 0

    Dim objWord As Word.Application
    Set objWord = New Word.Application
    objWord.Visible = True

    Dim docDest As Word.Document
    'If the problem was to get the handle to the opened document, this should work better:
    Set docDest = objWord.Documents.Open(pathconew)

    docDest.Bookmarks("WNUMCO").Range.Text = FCO.NUMCO.Value
    docDest.Bookmarks("WDATECO").Range.Text = FCO.DATECO.Value
    docDest.Bookmarks("WNOMCLIENT").Range.Text = FCO.SOCIETENAME.Value

    docDest.SaveAs pathconew

    AppActivate ("CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx")
End Sub