Run-time Error 5 "Invalid Procedure Call or Argument"

[brent.fraser]

Hi all,I have an Excel Speadsheet that gathers content control information and places the information into a line in the Excel file.Things are working but I get the "Run-time Error 5 "Invalid Procedure Call or Argument"" error when I run it and I am not sure why. I tried to debug the code and I can run it to a point without the error but I can't pin-point the culprit.The code is below:

Option Explicit
Public strPath As String, strFile As String, strWordDocument As String
Public Sub ReplaceYes()
Cells.Replace What:=ChrW(9746), Replacement:="Yes", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Public Sub ReplaceNo()
Cells.Replace What:=ChrW(9744), Replacement:="No", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Public Sub GetFilePath()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "Select the Vendor Questionnaire to use"
fd.Filters.Add "Documents", "*.doc; *.docm; *.docx", 1
If fd.Show Then
strWordDocument = fd.SelectedItems(1)
strPath = strWordDocument
strFile = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
MsgBox strWordDocument
End If
End Sub
Sub GetFormData()
'Note: this code requires a reference to the Word object model
GetFilePath
Application.ScreenUpdating = False
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim CCtrl As Word.ContentControl
Dim WkSht As Worksheet, i As Long, j As Long
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
MsgBox strFile
While strFile ""
i = i + 1
Set wdDoc = wdApp.Documents.Open(Filename:=strWordDocument, AddToRecentFiles:=False, Visible:=False)
With wdDoc
j = 0
For Each CCtrl In .ContentControls
j = j + 1
WkSht.Cells(i, j) = CCtrl.Range.Text
Next
End With
Call ReplaceYes
Call ReplaceNo
wdDoc.Close SaveChanges:=False
strWordDocument = Dir()
Wend
wdApp.Quit Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True

End Sub

The sub-functions work (ReplaceYes, ReplaceNo, and GetFilePath) so I know the issue is somewhere in "GetFormData."Anyway, I know I am missing something but I am not sure yet. I am still trying to solve it.thanks everyone.

[brent.fraser]

The code isn't coming across correctly so I will try to put it in here:

Option Explicit
Public strPath As String, strFile As String, strWordDocument As String
Public Sub ReplaceYes()
Cells.Replace What:=ChrW(9746), Replacement:="Yes", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Public Sub ReplaceNo()
Cells.Replace What:=ChrW(9744), Replacement:="No", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Public Sub GetFilePath()
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.AllowMultiSelect = False
    fd.Title = "Select the Vendor Questionnaire to use"
    fd.Filters.Add "Documents", "*.doc; *.docm; *.docx", 1
    If fd.Show Then
    strWordDocument = fd.SelectedItems(1)
    strPath = strWordDocument
    strFile = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
    MsgBox strWordDocument
    End If
End Sub
Sub GetFormData()
     'Note: this code requires a reference to the Word object model
    GetFilePath
    Application.ScreenUpdating = False
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Dim CCtrl As Word.ContentControl
    Dim WkSht As Worksheet, i As Long, j As Long
    Set WkSht = ActiveSheet
    i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
    MsgBox strFile
    While strFile  ""
        i = i + 1
        Set wdDoc = wdApp.Documents.Open(Filename:=strWordDocument, AddToRecentFiles:=False, Visible:=False)
        With wdDoc
            j = 0
            For Each CCtrl In .ContentControls
                j = j + 1
                WkSht.Cells(i, j) = CCtrl.Range.Text
            Next
        End With
        Call ReplaceYes
        Call ReplaceNo
        wdDoc.Close SaveChanges:=False
        strWordDocument = Dir()
    Wend
    wdApp.Quit    Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
    Application.ScreenUpdating = True

End Sub

Hope this works.....

[SamT]

Formatted. With three added comments

Option Explicit

Public strPath As String
Dim strFile As String
Dim strWordDocument As String

Public Sub ReplaceYes()
   Cells.Replace What:=ChrW(9746), Replacement:="Yes" _
   'The rest are Defaults ', LookAt:=xlWhole, _SearchOrder:=xlByRows, _
      MatchCase:=False, SearchFormat:=False, _ReplaceFormat:=False
End Sub

Public Sub ReplaceNo()
   Cells.Replace What:=ChrW(9744), Replacement:="No"_
   'The rest are Defaults ', LookAt:=xlWhole, _SearchOrder:=xlByRows, _
      MatchCase:=False, SearchFormat:=False, _ReplaceFormat:=False
End Sub

Public Sub GetFilePath()
   Dim fd As FileDialog
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   fd.AllowMultiSelect = False
   fd.Title = "Select the Vendor Questionnaire to use"
   fd.Filters.Add "Documents", "*.doc; *.docm; *.docx", 1
   If fd.Show Then
      strWordDocument = fd.SelectedItems(1)
      strPath = strWordDocument
      strFile = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
      MsgBox strWordDocument
   End If
End Sub

Sub GetFormData()
   'Note: this code requires a reference to the Word object model
      
   Dim wdApp As New Word.Application
   Dim wdDoc As Word.Document
   Dim CCtrl As Word.ContentControl
   Dim WkSht As Worksheet, i As Long, j As Long
   
   GetFilePath
   Application.ScreenUpdating = False
     
   Set WkSht = ActiveSheet
   i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
   MsgBox strFile
   While strFile  ""  'While strFile What???  '= "", '<> "", 'Something Else?
      i = i + 1
      Set wdDoc = wdApp.Documents.Open(Filename:=strWordDocument, AddToRecentFiles:=False, Visible:=False)
      With wdDoc
         j = 0
         For Each CCtrl In .ContentControls
            j = j + 1
            WkSht.Cells(i, j) = CCtrl.Range.Text
         Next
      End With
      Call ReplaceYes
      Call ReplaceNo
      wdDoc.Close SaveChanges:=False
      strWordDocument = Dir()
   Wend
   wdApp.Quit
   Set wdDoc = Nothing
   Set wdApp = Nothing
   Set WkSht = Nothing
   Application.ScreenUpdating = True
End Sub

[p45cal]

you've set fd.multiselect to FALSE so I think the user can only select one file, so later in GetFormData you don't need a While..Wend loop, you only need to check whether the user has clicked Cancel which you can do with If strFile <> "" Then. So try this:

Sub GetFormData()     'Note: this code requires a reference to the Word Object model
GetFilePath
Application.ScreenUpdating = False
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim CCtrl As Word.ContentControl
Dim WkSht As Worksheet, i As Long, j As Long
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
MsgBox strFile
If strFile <> "" Then
  i = i + 1
  Set wdDoc = wdApp.Documents.Open(Filename:=strWordDocument, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    j = 0
    For Each CCtrl In .ContentControls
      j = j + 1
      WkSht.Cells(i, j) = CCtrl.Range.Text
    Next
  End With
  Call ReplaceYes
  Call ReplaceNo
  wdDoc.Close SaveChanges:=False
End If
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub

[brent.fraser]

Hey Sam and p45cal,

Yeah you nailed it.

I changed the fd.multiselect to false because originally I had the user navigate to one folder and process all word docs within that folder but the person i was doing this for said that there will be old files in the directory so he wanted the ability to browse and chose the file... so the While didn't work later on. I even tried the "if" and "end if" but must not have done something else as that didn't work.

Good catch guys!!!

Thanks very much! It's working well now.
B.