excelvbams-wordcopy-pasteonerror

Why does VBA come out of debug mode when ".paste" method is used to paste data from cell in MS Excel to a cell in a MS Word table?


The code below is intended to be used to copy a string from cells in an excel column sequentially (i=3 to 61), find a directory folder containing many copies of the same .doc file , and paste each string into the second row, first column of the first table in each .doc file.

Problem: The program un intentionally continues through loop and finishes running the rest of the code after executing the following line for the first time:

wddoc.Tables(1).Cell(2, 1).Range.Paste

This happens even though I am stepping into each line of code using F8 to reach this line of code. The code finishes running without having pasted anything into the remaining files in the directory. (The string in row 3 of the excel document was successfully pasted into plan template - Copy (10).docx but the remaining strings were not pasted into the remaining files)

The code:

Option Explicit
Sub CopyExcelToWord(path As String)

'variables----------------------------------------------------------------

'Decare Object variables for the Word application and file or documentl
Dim wdapp As Object, wddoc As Object, i As Integer

'Declare a String variable for the directory root and current file in that directory
Dim currentPath As String


'main process----------------------------------------------------------

'error handling is extremely important in making Excel work with Word
On Error Resume Next
'GetObject needs two parameters. The first is optional
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'we create a new instance of MS Word
Set wdapp = CreateObject("Word.Application")
End If

'Our application is made visible

wdapp.Visible = True

currentPath = Dir(path, vbDirectory)

For i = 3 To 61
Do Until currentPath = vbNullString
Debug.Print currentPath



        If Left(currentPath, 1) <> "." And Left(currentPath, 1) <> "" Then
        Debug.Print path & currentPath
           
            Sheet1.Range(Cells(i, 2), Cells(i, 2)).Copy
            'we activate our MS Word instance
            wdapp.Activate
            Set wddoc = wdapp.Documents(path & currentPath)
            If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(path & currentPath)
            wddoc.Activate
            wddoc.Tables(1).Cell(2, 1).Range.Paste
            'Free alocated memory and close
            wdapp.Quit
            Set wddoc = Nothing
            Set wdapp = Nothing
        'The following line of code removes the cell selection in Excel
        Application.CutCopyMode = False
        currentPath = Dir()
        Else
        
        currentPath = Dir()
        
        End If


           
Loop


Next
End Sub

The print ( I have placed a '...' where I have omitted a section of the path ):

. . .. . plan template - Copy (10).docx L C:**...**\ plan template - Copy (10).docx

The program runs through the rest of code unintentionally. The string in row 3 of the excel document was successfully pasted into plan template - Copy (10).docx and but the remaining strings were not pasted into the remaining files )

plan template Copy (11).docx L C:*...**\plan template - Copy (11).docx Lesson plan template - Copy (12).docx L C:*...\plan template -Copy (12).docx plan template - Copy (13).docx L C:**...\ plan template - L ... C:*...**\plan template - Copy (9).docx Lesson plan template.docx L C:*...**\plan template.docx


Solution

  • Your 'issue' is nothing to do with the paste command.

    Your code sets all errors to be ignored, creates a Word application object, then enters a loop where:

    1. a cell value is copied
    2. a Word document is opened
    3. the contents of the clipboard are pasted into a table cell in the Word document
    4. Word is shut down and the application object destroyed

    The first iteration of the loop will run successfully but subsequent iterations will error at each line that involves Word as the object no longer exists. Those errors are ignored because of On Error Resume Next.

    What you need to do:

    1. Reset error handling after the Word object has been obtained
    2. Add a flag if Word wasn't open so that it can be shut down when operations are complete
    3. Close the document and save the changes once it is finished with inside the loop
    4. Move wdapp.quit outside the loop

    As Word retains clipboard history and you are only copying the value of a single cell I would avoid using copy paste for this. Instead write the value directly to the table cell.

    This is how I would write your code:

    Option Explicit
    
    Sub CopyExcelToWord(path As String)
    
       'variables----------------------------------------------------------------
    
       'Decare Object variables for the Word application and file or document
       Dim wdapp As Object, wddoc As Object, i As Integer
    
       'Declare a String variable for the directory root and current file in that directory
       Dim currentPath As String
    
       'declare flag to show if Word needs to be quit
       Dim quitWord As Boolean
       
       'main process----------------------------------------------------------
    
       'error handling is extremely important in making Excel work with Word
       On Error Resume Next
       'GetObject needs two parameters. The first is optional
       Set wdapp = GetObject(, "Word.Application")
       If Err.Number = 429 Then
          Err.Clear
          'we create a new instance of MS Word
          Set wdapp = CreateObject("Word.Application")
          'as Word wasn't already open make application visible
          wdapp.Visible = True
          'set flag to show Word needs to be shut down
          quitWord = True
       End If
    
       'reset error handling so that any subsequent errors aren't ignored
       On Error GoTo 0
       
       currentPath = Dir(path, vbDirectory)
    
       For i = 3 To 61
          Do Until currentPath = vbNullString
             Debug.Print currentPath
    
             If Left(currentPath, 1) <> "." And Left(currentPath, 1) <> "" Then
                Debug.Print path & currentPath
               
                Set wddoc = wdapp.Documents.Open(path & currentPath)
                wddoc.Tables(1).Cell(2, 1).Range.Text = Sheet1.Range(Cells(i, 2), Cells(i, 2)).Value
                'document no longer required so close and save changes
                wddoc.Close -1 ' SaveChanges:=Word.wdSaveOptions.wdSaveChanges
                Set wddoc = Nothing
                
                currentPath = Dir()
             Else
            
                currentPath = Dir()
            
             End If
          Loop
       Next
       
       'Now that operations involving Word are complete quit Word if necessary and destroy objects
       If quitWord Then wdapp.Quit
       Set wdapp = Nothing
    End Sub