Compile error argument not optional

[plaem]

I have a VBA in Excel that check Word files for a certain keyword and then should copy the table following the keyword to an Excel worksheet. Using input from other forums I had separate codes for both; searching the keyword and table, and copying the table to Excel. However I fail to combine the two. Everytime I get a compile error in the bold line that the 'argument is not optional' but I fail to see where an argument is missing. Stand alone both scripts work as expected. If anyone is able to spot what is wrong and how it can be solved, that would be much appreciated.

Sub ImpTable()Dim oWdApp As New Word.Application
Dim oWdDoc As Word.Document
Dim oWdTable As Word.Table
Dim oWS As Worksheet
Dim lLastRow$, lLastColumn$
With ThisWorkbook


Set oWdDoc = oWdApp.Documents.Open("path")
'oWdDoc.Activate
'Application.ScreenUpdating = False
Dim StrFnd As String, Rng As Range, i As Long
StrFnd = "keyword"
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = StrFnd
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = .Information(wdActiveEndAdjustedPageNumber)
    Set Rng = ActiveDocument.GoTo(What:=wdGoToPage, Name:=i)
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
    If Rng.Tables.Count > 0 Then
      With Rng.Tables(1)
      Set oWdTable = Rng.Tables(1)
      
        oWdTable.Range.Copy
        oWS.Range("A1").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
       End With
      
    Else
      MsgBox "no table."
    End If
    .Start = Rng.End
    .Find.Execute
  Loop
End With
'Application.ScreenUpdating = True
oWdDoc.Close savechanges:=False
oWdApp.Quit
End With
End Sub

[SamT]

Show us the two Stand-Alone Codes.

[rlv]

.Start = Rng.End

I only dabble in Word VBA, but I'm fairly sure that is an illegal assignment. Your code defines ActiveDocument.Range as a Word range, while Rng is defined as an Excel range. The data types are not compatible. Perhaps if you redefined rng as a word range?

Dim Rng As Word.Range

[plaem]

Show us the two Stand-Alone Codes.

Here are the codes for respectively copying the Word table to Excel and analysing the Word file to find the table. I tried to combine these but this failed.

Sub CopyTableFromWordDoc(ByVal oFile As file)Dim oWdApp AsNew Word.Application                      ' Requires "Microsoft Word .. Object Library" reference
    Dim oWdDoc As Word.Document
    Dim oWdTable As Word.Table
    Dim oWS As Worksheet
    Dim lLastRow$, lLastColumn$

    ' Code to copy table from word document to this workbook in a new worksheet
    With ThisWorkbook

        
        ' Set oWdTable
        ' Copy the table to new worksheet
        oWdTable.Range.Copy
        oWS.Range("A1").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone

        ' Close the Word document
        oWdDoc.Close False

        ' Close word app
        oWdApp.Quit

    EndWith
 EndSub

Thanks to Zac.

and in Word VBA;

Sub Demo()Application.ScreenUpdating =False
Dim StrFnd AsString, Rng As Range, i AsLong
StrFnd = "keyword"
With ActiveDocument.Range
  With.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = StrFnd
    .Replacement.Text =""
    .Forward =True
    .Wrap = wdFindStop
    .Format =False
    .MatchCase =False
    .MatchWholeWord =False
    .MatchWildcards =False
    .MatchSoundsLike =False
    .MatchAllWordForms =False
    .Execute
  EndWith
  DoWhile.Find.Found
    i =.Information(wdActiveEndAdjustedPageNumber)
    Set Rng = ActiveDocument.GoTo(What:=wdGoToPage, Name:=i)
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
    If Rng.Tables.Count >0Then
      With Rng.Tables(1)
        'here the table should be copied to the Excel sheet
      EndWith
    Else
      MsgBox "No table."
    EndIf
    .Start = Rng.End
    .Find.Execute
  Loop
EndWith
Application.ScreenUpdating =TrueEndSub

Thanks to Macropod.

[plaem]

.Start = Rng.End

I only dabble in Word VBA, but I'm fairly sure that is an illegal assignment. Your code defines ActiveDocument.Range as a Word range, while Rng is defined as an Excel range. The data types are not compatible. Perhaps if you redefined rng as a word range?

Dim Rng As Word.Range

Dohh that makes perfect sense. I corrected that.

[plaem]

So bit by bit I have combined codes to get my desired script. The goal is to analyze a folder of various Word files, extract a certain table from each Word file and paste it into a separate Excel worksheet which has the name of the doc file:

Sub LookForWordDocs()Dim FolderName As String
With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  .Show
  On Error Resume Next
  FolderName = .SelectedItems(1)
  Err.Clear
  On Error GoTo 0
End With
    Dim sFoldPath As String: sFoldPath = FolderName     ' Change the path. Ensure that your have "\" at the end of your path
    Dim oFSO As New FileSystemObject                    ' Requires "Microsoft Scripting Runtime" reference
    Dim oFile As File
    ' Loop to go through all files in specified folder
    For Each oFile In oFSO.GetFolder(sFoldPath).Files
        ' Check if file is a word document. (Also added a check to ensure that we don't pick up a temp Word file)
        If ((InStr(1, LCase(oFSO.GetExtensionName(oFile.Path)), "doc", vbTextCompare) > 0) Or _
         (InStr(1, LCase(oFSO.GetExtensionName(oFile.Path)), "docx", vbTextCompare) > 0)) And _
                (InStr(1, oFile.Name, "~$") = 0) And _
                ((InStr(1, oFile.Name, "k") = 1) Or (InStr(1, oFile.Name, "K") = 1)) Then
            ' Call the UDF to copy from word document
            ImpTable oFile
        End If
    Next
End Sub


Sub ImpTable(ByVal oFile As File)
Dim oWdApp As New Word.Application
Dim oWdDoc As Word.Document
Dim oWdTable As Word.Table
Dim oWS As Excel.Worksheet
Dim lLastRow$, lLastColumn$
Dim s As String
s = "No correct table found"
With ThisWorkbook
Set oWS = Excel.Worksheets.Add
On Error Resume Next
oWS.Name = oFile.Name
On Error GoTo 0
Set sht = oWS.Range("A1")


Set oWdDoc = oWdApp.Documents.Open(oFile.Path)
oWdDoc.Activate
'Application.ScreenUpdating = False
Dim StrFnd As String, Rng As Word.Range, i As Long, j As Long
StrFnd = "keyword"
With Word.ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = StrFnd
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = .Information(wdActiveEndAdjustedPageNumber)
    Set Rng = ActiveDocument.Goto(What:=wdGoToPage, Name:=i)
    Set Rng = Rng.Goto(What:=wdGoToBookmark, Name:="\page")
    If Rng.Tables.Count > 0 Then
      With Rng.Tables(1)
      Set oWdTable = Rng.Tables(1)
        oWdTable.Range.Copy
        sht.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        j = 1
       End With
    End If
    .Start = Rng.End
    .Find.Execute
  Loop
End With
If j = 0 Then sht.Value = s
'Application.ScreenUpdating = True
oWdDoc.Close savechanges:=False
oWdApp.Quit
End With


Set oWS = Nothing
Set sht = Nothing
Set oWdDoc = Nothing
Set oWdTable = Nothing
Set Rng = Nothing


End Sub

With Word.ActiveDocument.Range
The first table copies fine but then I get a “Run-time error 462 : The remote server machine does not exist or is unavailable” on line "With Word.ActiveDocument.Range". Any idea what may cause this and how it can be solved?

[mana]

Option Explicit


Sub test()
    Dim wd As Word.Application
    Dim StrFnd As String
    Dim r As Word.Range, rr As Word.Range, t As Word.Table
    Dim p As String, f As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim n As Long
    Dim i As Long
    
     StrFnd = "keyword"
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Plesse choose the folder"
        If Not .Show Then Exit Sub
        p = .SelectedItems(1) & "\"
    End With
    
    Set wd = New Word.Application
    wd.Visible = True
    
    Set wb = Workbooks.Add(xlWBATWorksheet)


    f = Dir(p & "*.docx")
    
    Do While f <> ""
        With wd.Documents.Open(p & f)
            Set r = .Range
            With r.Find
                .Text = StrFnd
                Do While .Execute
                    Set t = Nothing
                    On Error Resume Next
                    Set t = r.GoTo(What:=wdGoToBookmark, Name:="\page").Tables(1)
                    On Error GoTo 0
                    Application.Wait [Now() + "0:00:00.1"]


                    If Not t Is Nothing Then
                        If ws Is Nothing Then
                            Set ws = wb.Worksheets.Add
                            ws.Name = f
                        End If
                        t.Range.Copy
                        ws.Range("a1").Offset(n).PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                        n = n + t.Rows.Count + 2
                    End If
                Loop
            End With
            .Close False
            Set ws = Nothing
            n = 0
        End With
        f = Dir()
    Loop

    wd.Quit
    Set wd = Nothing
    
End Sub

マナ

[SamT]

So bit by bit I have combined codes to get my desired script.

I try to break my code into many small Procedures, so I can Troubleshoot each one by itself. This also makes it easy to reuse Procedures