Tammy Allen
asked on
File.Search issue
I have the exact same issue as this gentlemen, but the code provided does not seem to work in the following module. Should I place it at the beginning or the end of my word merge code module? This is an Access 2003 database I am open in Access 2013 and the file search produces an error.
Public Function GetWordInsp(strInspDoc, Response, GotIt, DocSource)
'***START HERE*** ME: 10/21/04
DoCmd.Hourglass True
'pubInspDocFolder is a constant located in the GenMods module
'This Function gets an already-existing document, if it is there and if the user wants to use it
'check to see if there is already a document by this name in the Inspection Document Folder
'if not, exit this function
'If so, tell them it exists and find out if they want to replace it with a new one?
'If they don't want to replace it, exit this function; otherwise, make a new document
'If they want to replace it with a new one, open a brand new WordDocument for them according to name criteria
'ME: 3/19/07: added the following to determine proper Folder for Document Source (enf or insp)
Dim FolderSource As String
If DocSource = "enf" Then
FolderSource = pubEnfDocFolder
Else
FolderSource = pubInspDocFolder
End If
With Application.FileSearch
.NewSearch
.LookIn = FolderSource
.SearchSubFolders = True
.FileName = strInspDoc
.MatchAllWordForms = True
.FileType = msoFileTypeWordDocuments
If .Execute() = 0 Then
DoCmd.Hourglass False
If Response = "edit" Then
GotIt = 1
'MsgBox ("Inspection document " & strInspDoc & " does not exist in Word.")
End If
Exit Function
Else
'YOU GET HERE IF IT FINDS SOMETHING
'KeyCode = 0
'Display the Files *ProjectNum.Doc
Dim i As Integer
Dim ActualInspDoc As String
For i = 1 To .FoundFiles.Count
'Msgbox .foundfiles(i)
'response = MsgBox("Do you want to open " & .FoundFiles(i) & "?", vbYesNo)
'If response = vbYes Then
ActualInspDoc = .FoundFiles(i)
GoTo BRINGUP_THEDOCUMENT
'End If
Next i
End If
End With
BRINGUP_THEDOCUMENT:
Dim wApp As New Word.Application
Dim wDoc As Word.Document
' make new Word data file
On Error GoTo dMergeError
' open word merge document
Set wDoc = wApp.Documents.Open(Actual InspDoc)
wApp.Visible = True
wApp.WindowState = wdWindowStateMaximize
Exit_Here:
DoCmd.Hourglass False
Exit Function
dMergeError:
Select Case Err.Number
Case 5174
MsgBox ("Word doc named " & strInspDoc & " cannot be located.")
Case Else
MsgBox ("error # " & Err.Number & Err.Description)
End Select
Resume Exit_Here
End Function
Public Function GetWordInsp(strInspDoc, Response, GotIt, DocSource)
'***START HERE*** ME: 10/21/04
DoCmd.Hourglass True
'pubInspDocFolder is a constant located in the GenMods module
'This Function gets an already-existing document, if it is there and if the user wants to use it
'check to see if there is already a document by this name in the Inspection Document Folder
'if not, exit this function
'If so, tell them it exists and find out if they want to replace it with a new one?
'If they don't want to replace it, exit this function; otherwise, make a new document
'If they want to replace it with a new one, open a brand new WordDocument for them according to name criteria
'ME: 3/19/07: added the following to determine proper Folder for Document Source (enf or insp)
Dim FolderSource As String
If DocSource = "enf" Then
FolderSource = pubEnfDocFolder
Else
FolderSource = pubInspDocFolder
End If
With Application.FileSearch
.NewSearch
.LookIn = FolderSource
.SearchSubFolders = True
.FileName = strInspDoc
.MatchAllWordForms = True
.FileType = msoFileTypeWordDocuments
If .Execute() = 0 Then
DoCmd.Hourglass False
If Response = "edit" Then
GotIt = 1
'MsgBox ("Inspection document " & strInspDoc & " does not exist in Word.")
End If
Exit Function
Else
'YOU GET HERE IF IT FINDS SOMETHING
'KeyCode = 0
'Display the Files *ProjectNum.Doc
Dim i As Integer
Dim ActualInspDoc As String
For i = 1 To .FoundFiles.Count
'Msgbox .foundfiles(i)
'response = MsgBox("Do you want to open " & .FoundFiles(i) & "?", vbYesNo)
'If response = vbYes Then
ActualInspDoc = .FoundFiles(i)
GoTo BRINGUP_THEDOCUMENT
'End If
Next i
End If
End With
BRINGUP_THEDOCUMENT:
Dim wApp As New Word.Application
Dim wDoc As Word.Document
' make new Word data file
On Error GoTo dMergeError
' open word merge document
Set wDoc = wApp.Documents.Open(Actual
wApp.Visible = True
wApp.WindowState = wdWindowStateMaximize
Exit_Here:
DoCmd.Hourglass False
Exit Function
dMergeError:
Select Case Err.Number
Case 5174
MsgBox ("Word doc named " & strInspDoc & " cannot be located.")
Case Else
MsgBox ("error # " & Err.Number & Err.Description)
End Select
Resume Exit_Here
End Function
FileSearch was killed in Office 2007.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Tammy,
Also, in the future please use the "code" tag around your code samples. It makes comments and questions much, much easier to read (see how Dale did it above :) ).
Patrick
Also, in the future please use the "code" tag around your code samples. It makes comments and questions much, much easier to read (see how Dale did it above :) ).
Patrick
Thank you Dale and Patrick,
I updated the code with your guidance to the code below, but I receive an error on the event (see attached snapshot). I think I may still have too much coding in the original code below which was created in Access 2003. Is there additional code I can remove from below that you are aware of?
I updated the code with your guidance to the code below, but I receive an error on the event (see attached snapshot). I think I may still have too much coding in the original code below which was created in Access 2003. Is there additional code I can remove from below that you are aware of?
Public Function GetWordInsp(strInspDoc, Response, GotIt, DocSource)
'***START HERE*** ME: 10/21/04
DoCmd.Hourglass True
'pubInspDocFolder is a constant located in the GenMods module
'This Function gets an already-existing document, if it is there and if the user wants to use it
'check to see if there is already a document by this name in the Inspection Document Folder
'if not, exit this function
'If so, tell them it exists and find out if they want to replace it with a new one?
'If they don't want to replace it, exit this function; otherwise, make a new document
'If they want to replace it with a new one, open a brand new WordDocument for them according to name criteria
'ME: 3/19/07: added the following to determine proper Folder for Document Source (enf or insp)
Dim FolderSource As String
If DocSource = "enf" Then
FolderSource = pubEnfDocFolder
Else
FolderSource = pubInspDocFolder
End If
Public Function FileExists(FilePath As String, FileName As String) As Boolean
Dim strDelim As String
strDelim = IIf(Right(FilePath, 1) = "\", "", "\")
FileExists = Len(Dir(FilePath & strDelim & strFileName)) > 0
End Function
If .Execute() = 0 Then
DoCmd.Hourglass False
If Response = "edit" Then
GotIt = 1
'MsgBox ("Inspection document " & strInspDoc & " does not exist in Word.")
End If
Exit Function
Else
'YOU GET HERE IF IT FINDS SOMETHING
'KeyCode = 0
'Display the Files *ProjectNum.Doc
Dim i As Integer
Dim ActualInspDoc As String
For i = 1 To .FoundFiles.Count
'Msgbox .foundfiles(i)
'response = MsgBox("Do you want to open " & .FoundFiles(i) & "?", vbYesNo)
'If response = vbYes Then
ActualInspDoc = .FoundFiles(i)
GoTo BRINGUP_THEDOCUMENT
'End If
Next i
End If
End With
BRINGUP_THEDOCUMENT:
Dim wApp As New Word.Application
Dim wDoc As Word.Document
' make new Word data file
On Error GoTo dMergeError
' open word merge document
Set wDoc = wApp.Documents.Open(ActualInspDoc)
wApp.Visible = True
wApp.WindowState = wdWindowStateMaximize
Exit_Here:
DoCmd.Hourglass False
Exit Function
dMergeError:
Select Case Err.Number
Case 5174
MsgBox ("Word doc named " & strInspDoc & " cannot be located.")
Case Else
MsgBox ("error # " & Err.Number & Err.Description)
End Select
Resume Exit_Here
End Function
Tammy,
It appears that you inserted my function in the middle of your code. The code for the function FileExists needs to go into another code module, preferably a code module which is not attached to a form. So, remove lines 19-26 from that above code and put them in another code module.
Then, replace lines 28-35 wit:
Dale
It appears that you inserted my function in the middle of your code. The code for the function FileExists needs to go into another code module, preferably a code module which is not attached to a form. So, remove lines 19-26 from that above code and put them in another code module.
Then, replace lines 28-35 wit:
If FileExists(FolderSource, strInspDoc) = false Then
msgbox "Inspection document '" & strInspDoc & "' does not exist in folder: " & FolderSource
Else
HTHDale
Thank you Dale.
I moved the following code to my GenMods Module:
I was then left with the following code:
This resulted in the following returned error:
I moved the following code to my GenMods Module:
Public Function FileExists(FilePath As String, FileName As String) As Boolean
Dim strDelim As String
strDelim = IIf(Right(FilePath, 1) = "\", "", "\")
FileExists = Len(Dir(FilePath & strDelim & strFileName)) > 0
End Function
I was then left with the following code:
Public Function GetWordInsp(strInspDoc, Response, GotIt, DocSource)
'***START HERE*** ME: 10/21/04
DoCmd.Hourglass True
'pubInspDocFolder is a constant located in the GenMods module
'This Function gets an already-existing document, if it is there and if the user wants to use it
'check to see if there is already a document by this name in the Inspection Document Folder
'if not, exit this function
'If so, tell them it exists and find out if they want to replace it with a new one?
'If they don't want to replace it, exit this function; otherwise, make a new document
'If they want to replace it with a new one, open a brand new WordDocument for them according to name criteria
'ME: 3/19/07: added the following to determine proper Folder for Document Source (enf or insp)
Dim FolderSource As String
If DocSource = "enf" Then
FolderSource = pubEnfDocFolder
Else
FolderSource = pubInspDocFolder
End If
If FileExists(FolderSource, strInspDoc) = false Then
msgbox "Inspection document '" & strInspDoc & "' does not exist in folder: " & FolderSource
Else
'YOU GET HERE IF IT FINDS SOMETHING
'KeyCode = 0
'Display the Files *ProjectNum.Doc
Dim i As Integer
Dim ActualInspDoc As String
For i = 1 To .FoundFiles.Count
'Msgbox .foundfiles(i)
'response = MsgBox("Do you want to open " & .FoundFiles(i) & "?", vbYesNo)
'If response = vbYes Then
ActualInspDoc = .FoundFiles(i)
GoTo BRINGUP_THEDOCUMENT
'End If
Next i
End If
End With
BRINGUP_THEDOCUMENT:
Dim wApp As New Word.Application
Dim wDoc As Word.Document
' make new Word data file
On Error GoTo dMergeError
' open word merge document
Set wDoc = wApp.Documents.Open(ActualInspDoc)
wApp.Visible = True
wApp.WindowState = wdWindowStateMaximize
Exit_Here:
DoCmd.Hourglass False
Exit Function
dMergeError:
Select Case Err.Number
Case 5174
MsgBox ("Word doc named " & strInspDoc & " cannot be located.")
Case Else
MsgBox ("error # " & Err.Number & Err.Description)
End Select
Resume Exit_Here
End Function
This resulted in the following returned error:
Have you attempted to compile the code and deal with the errors? Do you know how to do that? There appear to be a couple of errors in your code which follows. Since I don't have all of the code, I'm just going to attempt to resolve the issues withing the following code segment:
Dim FolderSource As String
If DocSource = "enf" Then
FolderSource = pubEnfDocFolder
Else
FolderSource = pubInspDocFolder
End If
If FileExists(FolderSource, strInspDoc) = false Then
msgbox "Inspection document '" & strInspDoc & "' does not exist in folder: " & FolderSource
Else
'YOU GET HERE IF IT FINDS SOMETHING
'KeyCode = 0
'Display the Files *ProjectNum.Doc
Dim i As Integer
Dim ActualInspDoc As String
For i = 1 To .FoundFiles.Count
'Msgbox .foundfiles(i)
'response = MsgBox("Do you want to open " & .FoundFiles(i) & "?", vbYesNo)
'If response = vbYes Then
ActualInspDoc = .FoundFiles(i)
GoTo BRINGUP_THEDOCUMENT
'End If
Next i
End If
End With
I believe you need to modify that code as follows. Keeping in mind that my FileExists code will only identify whether a single file exists, not whether multiple files exist which meet some specific search criteria.Dim FolderSource As String
If DocSource = "enf" Then
FolderSource = pubEnfDocFolder
Else
FolderSource = pubInspDocFolder
End If
If FileExists(FolderSource, strInspDoc) = false Then
msgbox "Inspection document '" & strInspDoc & "' does not exist in folder: " & FolderSource
Else
'YOU GET HERE IF IT FINDS SOMETHING
'Display the Files *ProjectNum.Doc
if msgbox("Would you like to open file: " & strInspDoc & "?", vbYesNo) = vbYes Then
ActualInspDoc = FolderSource & IIF(Right(FolderSource, 1) <> "\", "\", "") & strInspDoc
GoTo BRINGUP_THEDOCUMENT
End If
End if
Unfortunately, I do not know how to compile the code and deal with the errors. Is there a tutorial site. I did update the code to the above code you suggested. The syntax error remains. The code is part of a very large wordmerge code with similar codes for finding a pdf, a word file, etc. I thought if I could resolve this code, the others would be simple duplications. An edit button is clicked which is supposed to trigger the file search. The event associated with the edit button has the following VBA code.
I have read Access 2013 is unagreeable with quotations, but I am thinking maybe the cross-reference to the above code is incorrect.
Private Sub cmdWDInsp_Click()
Dim DocSource
DocSource = ""
Dim strInspName
Dim strWordInsp
Dim strPDFInsp As String
If IsNull(Forms![fFacInsp01]![fFacInspSetup01].Form![Proj_ID]) Then
MsgBox ("Project # is needed to open Word document!")
Exit Sub
End If
'develops a Word document name from the Project #
'rgp 2015Mar27 removed the *
'strWordInsp = "*" & (Forms![fFacInsp01]![fFacInspSetup01].Form![Proj_ID]) & ".doc"
strWordInsp = (Forms![fFacInsp01]![fFacInspSetup01].Form![Proj_ID]) & ".doc"
'develops a PDF document name from the Project #
strPDFInsp = "*" & (Forms![fFacInsp01]![fFacInspSetup01].Form![Proj_ID]) & ".pdf"
strInspName = "*" & (Forms![fFacInsp01]![fFacInspSetup01].Form![Proj_ID])
'MsgBox (strWordInsp & " would be the Inspection Document name")
Dim Response
Response = "edit"
Dim GotIt
GotIt = 0
Call GetWordInsp(strWordInsp, Response, GotIt, DocSource)
If GotIt = 1 Then
Call GetPDFInsp(strPDFInsp, Response, GotIt, DocSource)
End If
If GotIt = 2 Then
MsgBox ("Inspection document " & strInspName & " does not exist.")
End If
End Sub
Private Sub ipInspDate_DblClick(Cancel As Integer)
[ipInspDate] = CalendarProc([ipInspDate])
End Sub
Private Sub ipInspDate_KeyDown(KeyCode As Integer, Shift As Integer)
Call ModDate(KeyCode, [ipInspDate])
End Sub
Private Sub ipInspID_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> vbKeyDelete Then
KeyCode = 0
Exit Sub
End If
KeyCode = 0
If IsNull(Me![ipInspID]) Then Exit Sub
Dim Response
Response = MsgBox("You are about to delete Insp_ID " & Str(Me![ipInspID]) & " Is that ok?", 36)
If Response = vbNo Then Exit Sub
DoCmd.Echo False
DoCmd.SetWarnings False
DoCmd.OpenQuery "qDelFACINSPRec2"
DoCmd.SetWarnings True
MsgBox ("FAC_INSP record will be deleted")
Forms![fFacInsp01]![fProjectData2].Requery
DoCmd.Echo True
End Sub
Private Sub ipPerID_AfterUpdate()
[ipARMS#] = DLookup("[ARMS#]", "PERMITS", "[Per_ID] =" & Me![ipPerID])
[ipFacID] = DLookup("[Fac_ID#]", "PERMITS", "[Per_ID] =" & Me![ipPerID])
End Sub
Private Sub ipPerID_DblClick(Cancel As Integer)
Dim FieldData As String
Dim StringID
StringID = [ipPerID]
FieldData = StringID & "{{{fFacInspSetup01"
DoCmd.OpenForm "finfoPermits", , , , , , FieldData
End Sub
Private Sub ipPerID_KeyDown(KeyCode As Integer, Shift As Integer)
If IsNull([ipPerID]) Then Exit Sub
If KeyCode = 13 Then
SendKeys "{F2}", True
SendKeys "{HOME}", True
Exit Sub
End If
If KeyCode = vbKeyF3 Then
Dim FieldData As String
Dim StringID
StringID = [ipPerID]
FieldData = StringID & "{{{fFacInspSetup01"
DoCmd.OpenForm "finfoPermits", , , , , , FieldData
Exit Sub
End If
If KeyCode = vbKeyReturn Then
SendKeys "{F2}", True
SendKeys "{HOME}", True
Exit Sub
End If
If KeyCode = vbKeyDelete Then
KeyCode = 0
MsgBox ("To delete this record use the Facility Input Form!")
End If
End Sub
Private Sub Command356_Click()
On Error GoTo Err_Command356_Click
Screen.PreviousControl.SetFocus
DoCmd.FindNext
Exit_Command356_Click:
Exit Sub
Err_Command356_Click:
MsgBox Err.Description
Resume Exit_Command356_Click
End Sub
I have read Access 2013 is unagreeable with quotations, but I am thinking maybe the cross-reference to the above code is incorrect.