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
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:
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:
wdapp.quit
outside the loopAs 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