Consulting

Results 1 to 5 of 5

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

  1. #1
    VBAX Newbie
    Joined
    Oct 2021
    Posts
    3
    Location

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

    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!

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,449
    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.
    Last edited by p45cal; 10-20-2021 at 08:09 AM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    VBAX Newbie
    Joined
    Oct 2021
    Posts
    3
    Location
    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

  4. #4
    Knowledge Base Approver VBAX Wizard
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,449
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  5. #5
    VBAX Newbie
    Joined
    Oct 2021
    Posts
    3
    Location
    Just ran it and it's noticeably quicker with a greater number of files. Really appreciate all of your help!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •