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 As New 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

End With
End Sub

Thanks to Zac.

and in Word VBA;


Sub Demo()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)
'here the table should be copied to the Excel sheet
End With
Else
MsgBox "No table."
End If
.Start = Rng.End
.Find.Execute
Loop
End With
Application.ScreenUpdating = True End Sub

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