Pasting not working in Excel VBA

[Shaun Allan]

I have a workbook which creates Word reports based on a Word template and tables in the workbook.

Depending on the equipment type, it copies a range from the spreadsheet and pastes it to two bookmark locations in the word document (bmInternal and bmExternal). I tried using PasteAppendTable, but this only works once. If I try to use it twice, for each bookmark, it copies nothing both times. As such I used Paste for one and PasteAppendTable for the second (PasteAppendTable is much neater as the formatting is better).

This worked fine, but I made changes to the code, not related to this, and now the Paste (which goes to bmInternal) isn't working. I can't see why when I've not changed anything regarding that part:

Sub Data2Word()
    
    Application.GoTo Reference:=ActiveSheet.Range("A2")
    
GoAgain:
On Error Resume Next
    Dim vItem As String
    'Dim vImagePath As String
    
    Dim vCurrentRow As Integer
    
    Dim vDesc As String
    Dim vN2 As String
    Dim vGuide As String
    Dim vUnit As String
    Dim vBlock As String
            
    Dim wrdPic As Word.InlineShape
    Dim rng As Excel.Range                    'our source range
    Dim rngText As Variant
    Dim rngText2 As Variant
    
    Dim wdApp As New Word.Application   'a new instance of Word
    Dim wdDoc As Word.Document          'our new Word template
    Dim myWordFile As String            'path to Word template
    Dim wsExcel As Worksheet
    Dim tmpAut
    
'Find Item and type
    vItem = ActiveCell.Value
    vDesc = ActiveCell.Offset(0, 2)
    vN2 = ActiveCell.Offset(0, 1)
    vGuide = ActiveCell.Offset(0, 3)
    vBlock = ActiveCell.Offset(0, 4)
    vUnit = Left(vItem, 3)
    
    If ActiveSheet.Range("rngREPORTED") = "Yes" Then
        MsgBox vItem & " already has a report."
        Exit Sub
    End If
    'initialize the Word template path
    'here, it's set to be in the same directory as our source workbook
    myWordFile = "W:\Entity\Inspect\WORD\INSPECTION TEMPLATES\Inspection Template - 20160511.dotx"
    
    'open a new word document from the template
    Set wdDoc = wdApp.Documents.Add(myWordFile)
    
    If vGuide = "IGE01" Then
    
        rngText = "rngEXCH"
        rngText2 = "rngEXCHE"
        
    ElseIf ActiveCell.Offset(, 4) = "Mono" Then
    
        'Do Mono
        rngText = "rngMONO"
    
    Else
            
            ActiveWorkbook.Names.Add Name:="rngItemSub", RefersTo:=Worksheets("SubEquipment").Range("B" & ActiveCell.Offset(0, 6) & ":C" & ActiveCell.Offset(0, 7) + ActiveCell.Offset(0, 6))

CarryOn:
            rngText = "rngItemSub"
            
    End If
    
    'Insert Tables
    'get the range of the data
     
    Set rng = Range(rngText)
    rng.Copy                            'copy the range
    
    wdDoc.Bookmarks("bmInternal").Range.Paste 'AppendTable
    
    If vGuide = "IGE01" Then
        Set rng = Range(rngText2)
        rng.Copy
    End If
    
    wdDoc.Bookmarks("bmExternal").Range.PasteAppendTable
    
    wdDoc.Bookmarks("bmItem").Range.InsertAfter vItem
    wdDoc.Bookmarks("bmDesc").Range.InsertAfter vDesc
    wdDoc.Bookmarks("bmN2").Range.InsertAfter vN2
    wdDoc.Bookmarks("bmGuide").Range.InsertAfter vGuide
    wdDoc.Bookmarks("bmBlock").Range.InsertAfter vBlock
    
    wdDoc.Variables("wvItem").Value = vItem
    ActiveDocument.Fields.Update

    With wdDoc
            Set wrdPic = .Bookmarks("bmImage").Range.InlineShapes.AddOLEObject(ClassType:="AcroExch.Document.7", Filename:="W:\Entity\Inspect\T&I\2016\Various Items\Photos\Sorted\" & vItem & ".pdf", LinkToFile:=False, DisplayAsIcon:=False)
            wrdPic.ScaleHeight = 55
            wrdPic.ScaleWidth = 55
    End With
    
    wdApp.Visible = True
    
    wdApp.Activate
    
    wdDoc.SaveAs "W:\Entity\Inspect\WSDATA\REPORTS\2016\" & vUnit & "\" & vItem & " " & vN2 & " THO.docx" 'Mid(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 4)

MoveHere:
    
    ActiveWorkbook.Sheets("AllItems").Range("G" & ActiveCell.Offset(0, 8)).Value = "Yes"
    ActiveWorkbook.Save

End Sub

 

[Norie]

Can't you repeat the copy before pasting again?

 

[Shaun Allan]

I've tried that for both parts, but it doesn't seem to work. Currently, the bmExternal (PasteAppendTable) works but the bmInternal (Paste) isn't working. I can't see why, though. It WAS working. Using PasteAppendTable both times would work better, but then neither pastes anything.

 

[Norie]

If you remove On Error Resume Next then run the code do you get any errors?

 

[Shaun Allan]

I get error 4198, but it doesn't show me which line is creating the error.

 

[Norie]

No option to Debug?

Any error message?

 

[Shaun Allan]

It gives a blank error, or if the 4198 comes up no line is highlighted as being in error.

 

[Norie]

I've had a quick search on that error number and the usual message that goes with it is the somewhat vague 'Command failed'.

Making things even vaguer is no specific line being highlighted by the debugger.

I've looked through the code a couple of times and the only thing, to me anyway, that stands out is this.

    ActiveDocument.Fields.Update

If this code is being run from Excel then ActiveDocument doesn't really mean anything within the Excel VBA environment, and that could cause problems.

Try replacing ActiveDocument with wdDoc, which you've been using throughout the rest of the code.

 

[Shaun Allan]

Thanks Norie. Actually, that command does work (in updating the fields within the document) but I'll give it a go. I appreciate your time.