"Object variable or with block variable not set" Error on Second loop of For Loop

[tjone102]

Hello,


I wrote some code to pull content controlled fields in word, search the title of the field in the header of an excel table, identify the column number, determine the next row in that column, and paste the value of the field.


The code actually seems to work fine except when it tries to loop in the next word doc in the specified folder.


here's the entire module.



'This code pulls word documents with Content Controls and inserts them into a spreadsheet for analysis
Sub getformdata()
'Prevents screen from refreshing during Macro to make it more efficient
Application.ScreenUpdating = False
'
'Set up variables
Dim wdapp As New Word.Application
Dim wdDoc As Word.Document
Dim CCtrl As Word.ContentControl
Dim strFolder As String
Dim strFile As String
Dim WkSht As Worksheet
Dim i As Long
Dim j As Long


'Defines "strfolder" as the appropriate folder from which you want to pull your word documents from
'It does so using the "GetFolder()" separate function below
strFolder = GetFolder
'If there is nothing in the specified folder, this line tells the macro to stop
If strFolder = "" Then Exit Sub
'
'
'Set data to dump on sheet number one regardless of what sheet in the work book you are on
Set WkSht = Worksheets(1)
'Sets "strFile" as the name of the first word doc in the chosen folder path
strFile = Dir(strFolder & "\*.doc", vbNormal)
'The below while loop grabs a word doc in the specified folder, pastes all the Content Controlled fields of a word doc in a specified row/column based on the column header in row 1
While strFile <> ""
Set wdDoc = wdapp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False, ReadOnly:=True)
With wdDoc
'This loop grabs each form field from a word doc and places it in its specified "ith" row and "jth" collumn
'Every row is the same for each document, while every collumn is the consequent field form.
For Each CCtrl In .ContentControls
With CCtrl
Select Case .Type
Case wdContentControlDate, wdContentControlDropdownList, wdContentControlRichText, wdContentControlText
j = Application.WorksheetFunction.Match(CCtrl.Title, Range("1:1"), 0)
i = WkSht.Cells(WkSht.Rows.Count, j).End(xlUp).Row
i = i + 1
WkSht.Cells(i, j).Value = .Range.Text
Case Else
End Select
End With
Next

wdDoc.Close SaveChanges:=False
strFile = Dir()
wdapp.Quit
Set wdDoc = Nothing: Set wdapp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End With
Wend
End Sub


' The following function is called for use in the above Sub getformdata()
'
'The function opens up a box to select the folder for which all the word docs in question should be located
'Do not select a folder that does not contain word docs with form fields


Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function


The piece that is giving me trouble is



For Each CCtrl In .ContentControls
With CCtrl
Select Case .Type
Case wdContentControlDate, wdContentControlDropdownList, wdContentControlRichText, wdContentControlText
j = Application.WorksheetFunction.Match(CCtrl.Title, Range("1:1"), 0)
i = WkSht.Cells(WkSht.Rows.Count, j).End(xlUp).Row
i = i + 1
WkSht.Cells(i, j).Value = .Range.Text
Case Else
End Select
End With
Next



I am getting a "Run time error '91' Object variable or with block variable not set" on the line "i = WkSht.Cells(WkSht.Rows.Count, j).End(xlUp).Row" ONLY on the second loop.


If anyone has any insight or resources on this problem it would be much appreciated.


Thanks!

[p45cal]

1. Remove the last parts of:
Set wdDoc = Nothing: Set wdapp = Nothing: Set WkSht = Nothing
to leave:
Set wdDoc = Nothing
or remove that line completely.
2. Move wdapp.Quit to just before End Sub.

The code could be a bit more efficient… perhaps more on that later.

[tjone102]

Thanks p45cal! I ended up removing the line containing " Set wdDoc = Nothing: Set wdapp = Nothing: Set WkSht = Nothing".

It also seems to work with "wdApp.Quit" removed completely.

Can you speak to the efficiency of the code? I'm no programmer, and it probably shows.

For continuity's sake, I will repost my updated code below.



'This code pulls word documents with Content Controls and inserts them into a spreadsheet for analysisSub getformdata()
'Prevents screen from refreshing during Macro to make it more efficient (???)
Application.ScreenUpdating = False
'
'Set up variables
Dim wdapp As New Word.Application
Dim wdDoc As Word.Document
Dim CCtrl As Word.ContentControl
Dim strFolder As String
Dim strFile As String
Dim WkSht As Worksheet
Dim i As Long
Dim j As Long


'Defines "strfolder" as the appropriate folder from which you want to pull your word documents from
'It does so using the "GetFolder()" separate function below
strFolder = GetFolder
'If there is nothing in the specified folder, this line tells the macro to stop
If strFolder = "" Then Exit Sub
'
'
'Set data to dump on sheet number one regardless of what sheet in the work book you are on
Set WkSht = Worksheets(1)
'Sets "strFile" as the name of the first word doc in the chosen folder path
strFile = Dir(strFolder & "\*.doc", vbNormal)
'The below while loop grabs a word doc in the specified folder, pastes all the Content Controlled fields of a word doc in a specified row/column based on the column header in row 1
While strFile <> ""
Set wdDoc = wdapp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False, ReadOnly:=True)
With wdDoc
For Each CCtrl In .ContentControls
With CCtrl
Select Case .Type
Case wdContentControlDate, wdContentControlDropdownList, wdContentControlRichText, wdContentControlText
j = Application.WorksheetFunction.Match(CCtrl.Title, Range("1:1"), 0)
i = WkSht.Cells(WkSht.Rows.Count, j).End(xlUp).Row
i = i + 1
WkSht.Cells(i, j).Value = .Range.Text
Case Else

End Select
End With
Next

wdDoc.Close SaveChanges:=False
strFile = Dir()
Application.ScreenUpdating = True
End With
Wend
End Sub


' The following function is called for use in the above Sub getformdata()
'
'The function opens up a box to select the folder for which all the word docs in question should be located
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

[p45cal]

It's not a good idea to lose wdapp.Quit, you'll end up with an invisible instance of Word every time you run the macro.
The following has several changes, see comments.
Sub getformdata3()
'This code pulls word documents with Content Controls and inserts them into a spreadsheet for analysisSub getformdata()
'
'Set up variables
Dim wdapp As New Word.Application
Dim wdDoc As Word.Document
Dim CCtrl As Word.ContentControl
Dim strFolder As String
Dim strFile As String
Dim WkSht As Worksheet
Dim i As Long
Dim j As Long

'Defines "strfolder" as the appropriate folder from which you want to pull your word documents from
'It does so using the "GetFolder()" separate function below
strFolder = GetFolder
'If there is nothing in the specified folder, this line tells the macro to stop
If strFolder = "" Then Exit Sub
'Set data to dump on sheet number one regardless of what sheet in the work book you are on
Set WkSht = Worksheets(1)
'Sets "strFile" as the name of the first word doc in the chosen folder path
strFile = Dir(strFolder & "\*.doc", vbNormal)
'Prevents screen from refreshing during Macro to make it more efficient (???)
Application.ScreenUpdating = False 'moved this down (if Exit Sub is executed, it'll never be set back to true).
'The below while loop grabs a word doc in the specified folder, pastes all the Content Controlled fields of a word doc in a specified row/column based on the column header in row 1
While strFile <> ""
Set wdDoc = wdapp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False, ReadOnly:=True)
With wdDoc
For Each CCtrl In .ContentControls
With CCtrl
Select Case .Type
Case wdContentControlDate, wdContentControlDropdownList, wdContentControlRichText, wdContentControlText
j = Application.Match(CCtrl.Title, Range("1:1"), 0) 'missing out .WorksheeetFunction means no error is thrown if no match is found…
If Not IsError(j) Then 'whereas this line checks for no error.
i = WkSht.Cells(WkSht.Rows.Count, j).End(xlUp).Row + 1
WkSht.Cells(i, j).Value = .Range.Text
Else 'this and the line below can be deleted; just there to alert you, the developer, when something's not found
MsgBox CCtrl.Title & " not found in first row of sheet." 'this can go too.
End If
End Select
End With
Next CCtrl
wdDoc.Close SaveChanges:=False
strFile = Dir()
End With
Wend
Application.ScreenUpdating = True
wdapp.Quit 'needs to be kept
End Sub

[tjone102]

Just ran it and it's noticeably quicker with a greater number of files. Really appreciate all of your help!