If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. 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
      MsgBox "no table."
    End If
    .Start = Rng.End
    .Find.Execute
End With
'Application.ScreenUpdating = True
oWdDoc.Close savechanges:=False
oWdApp.Quit
End With
End Sub

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
      MsgBox "No table."
    EndIf
    .Start = Rng.End
    .Find.Execute
EndWith
Application.ScreenUpdating =TrueEndSub

Thanks to Macropod.

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
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
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? 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 End With .Close False Set ws = Nothing n = 0 End With f = Dir() wd.Quit Set wd = Nothing End Sub