Need File Code and Search Code Updated. 1

[tlallen]

I am totally lost. Our IT staff will no longer support Microsoft Access. We were working in Access 2010 and now we have been upgraded to Microsoft Access 2016. Surprisingly, our data base still works except when we try to run the following module. Can anyone help us re-write the module included in this post. We keep getting a 91 error code. We have to keep this database running until we get a replacement database. I apologize if I am posting this incorrectly and I am open to guidance on how or where to post for help. We know it has something to do with Application.File search and our End With Syntax.

With Application.FileSearch
.NewSearch
.LookIn = pubPermitDocFolder 'a constant in GenMods module
.SearchSubFolders = False
.FileName = finddoc
.MatchTextExactly = True
.FileType = msoFileTypeWordDocuments
If .Execute() > 0 Then
pubCopyPermitDoc = finddoc
Else
pubCopyPermitDoc = Null
MsgBox ("An electronic version of the permit conditions is not available." & CR & "Please see your supervisor about creating one, or using an" & CR & "existing inspection format.")
Exit Sub
End If
End With
DoTheMerge:
Call dmerge(WordDoc, MergeQuery, SaveFolder)
Exit Sub
dfLettersPInspError:
MsgBox ("error # " & Err.Number & Err.Description)
Resume Next
End Sub

 

[zandsc1]

First, let's clean up the code a little and make it readable:

With Application.FileSearch
	.NewSearch
	.LookIn = pubPermitDocFolder 'a constant in GenMods module
	.SearchSubFolders = False
	.FileName = finddoc
	.MatchTextExactly = True
	.FileType = msoFileTypeWordDocuments

	If .Execute() > 0 Then
		pubCopyPermitDoc = finddoc
	Else
		pubCopyPermitDoc = Null
		MsgBox ("An electronic version of the permit conditions is not available." & CR & _
                        "Please see your supervisor about creating one, or using an" & CR & "existing inspection format.")
		Exit Sub
	End If

End With

DoTheMerge:
Call dmerge(WordDoc, MergeQuery, SaveFolder)
Exit Sub

dfLettersPInspError:
	MsgBox ("error # " & Err.Number & Err.Description)
	Resume Next

End Sub

Next, it looks like there's several pieces of information needed to be able to answer your question.
[ul]What code is generating the runtime error?
The bit of code you posted is just a fragment of a procedure, can you post the entire procedure?
It's possible the error may be generated by some of the procedures being called within this code, can you post those procedures as well?[/ul]

 

[tlallen]

It is a large code for merging which is causing the error. I do know this was in Access 2007, but it looks like a mess. I tried the basic debugging and compiling the code and no errors come up in Access 2016. The dmerge causes the error. The database is for inspections and facility permits. Inspections are created by using a query which is exported into an excel spreadsheet and then merged into a word document. I was told this was an old way of merging documents.

The form which calls up the dmerge has the following code.

[ignore]Dim finddoc As String
finddoc = Mid(Forms![fFacInsp01]![fFacInspSetup01].Form![ipPermNo], 3, 5) & Mid(Forms![fFacInsp01]![fFacInspSetup01].Form![ipPermNo], 9, 3) & Mid(Forms![fFacInsp01]![fFacInspSetup01].Form![ipPermNo], 13, 2) & " " & Mid(Forms![fFacInsp01]![fFacInspSetup01].Form![ipARMS#], 6, 3) & ".doc"
Dim CR
CR = Chr(13)
On Error GoTo dfLettersPInspError
With Application.FileSearch
.NewSearch
.LookIn = pubPermitDocFolder 'a constant in GenMods module
.SearchSubFolders = False
.FileName = finddoc
.MatchTextExactly = True
.FileType = msoFileTypeWordDocuments
If .Execute() > 0 Then
pubCopyPermitDoc = finddoc
Else
pubCopyPermitDoc = Null
MsgBox ("An electronic version of the permit conditions is not available." & CR & "Please see your supervisor about creating one, or using an" & CR & "existing inspection format.")
Exit Sub
End If
End With
DoTheMerge:
Call dmerge(WordDoc, MergeQuery, SaveFolder)
Exit Sub
dfLettersPInspError:
MsgBox ("error # " & Err.Number & Err.Description)
Resume Next
End Sub
[/ignore]


The dmerge code is in a module and has this code.

Option Compare Database
Option Explicit

Public Function dmerge(StrTemplate As String, StrQuery As String, strFolder As String)
DoCmd.Hourglass True
'pubCurrDBPath is a variable located in the GenMods module
'it is normally primed when db is opened via macro
'AutoExec(Runcode OpenProcs) by a call to genCurrDBPath
If pubCurrDBPath = "" Then Call genCurrDBPath
'this field is checked later in the procedure for a template named Generic or Generic CMS (added 9/2008)
Dim HoldStrTemplate
HoldStrTemplate = StrTemplate
'pubTemplateFolder is a constant located in the GenMods module
StrTemplate = pubTemplateFolder & StrTemplate
If StrQuery = "none" Then GoTo SkipQuery
'Run query
Dim dbs As DAO.Database, rst As DAO.Recordset, qdf As DAO.QueryDef
Dim N As Integer
Dim StrDataDoc As String
StrDataDoc = pubCurrDBPath & "WDmerge.xls"
'delete current Excel data file.
'ignore error if file doesn't exist
On Error Resume Next
'from a macro for adding a new sheet to the spreadsheet
''If StrDataDoc Then
    'Sheets.Add
    'Sheets("Sheet1").Select
'    Sheets("Sheet1").Name = "XYZ"
'    Range("A1").Select
''Else
'original

Kill StrDataDoc
On Error GoTo 0
Set dbs = CurrentDb
On Error GoTo dMergeError
Set qdf = dbs.QueryDefs(StrQuery)
'this checks that the query results in data to merge
For N = 0 To qdf.Parameters.Count - 1
qdf.Parameters(N) = Eval(qdf.Parameters(N).Name)
Next N
Set rst = qdf.OpenRecordset
'exit function if recordset is empty
If rst.EOF Then
    MsgBox "No data to merge.", vbInformation, "Mail Merge"
    rst.Close
    GoTo Exit_Here
End If
rst.Close
qdf.Close
SkipQuery:
Dim wApp As New Word.Application
Dim wDoc As Word.Document
On Error GoTo dMergeError
' open word merge template document
Set wDoc = wApp.Documents.Open(StrTemplate)
'Dim strSampleFile
'strSampleFile = pubCurrDBPath & "Sample.doc"
'if there is no query associated with the passed strTemplate
'then goto procedure exit
If StrQuery <> "none" Then GoTo DodMerge
'StrQuery "none" means that the document is a blank
'form with no merge required
'this copies the template document and pastes it to a
'new open document
wDoc.Select
wApp.Selection.Copy
'close the templates document
wDoc.Close (wdDoNotSaveChanges)
'Documents.Add DocumentType:=wdNewBlankDocument
wApp.Documents.Add DocumentType:=wdNewBlankDocument
wApp.Selection.Paste
GoTo FinishUpDoc
'merge processing
DodMerge:
On Error GoTo dMergeError
'transfer data from the query to the Excel spreadsheet for merging with template data
'NOTE: An excel spreadsheet is used instead of a txt file because the
'latter has problems with quotes within the text
'original statement
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, StrQuery, StrDataDoc, True
'possible newer version of Excel
    'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel2003, StrQuery, StrDataDoc, True



'execute merge
With wDoc.MailMerge
.MainDocumentType = wdFormLetters
.SuppressBlankLines = True
.Destination = wdSendToNewDocument
'6/15/05:  ME:  change format to wdOpenFormatDocument; hopefully will correct issue w. Generic merge
'.OpenDataSource Name:=StrDataDoc, Format:=wdOpenFormatDocument, LinkToSource:=False, Connection:="Entire Spreadsheet"
'.OpenDataSource Name:=StrDataDoc, Format:=wdOpenFormatAuto, LinkToSource:=False, Connection:="Entire Spreadsheet"
'12/20/05: ME: subtype is Word2000 for the merges
.OpenDataSource Name:=StrDataDoc, Format:=wdOpenFormatDocument, LinkToSource:=False, Connection:="Entire Spreadsheet", subtype:=wdMergeSubTypeWord
.Execute
End With
'close the merge 'template document' without saving
wDoc.Close (wdDoNotSaveChanges)
'ME:  6/21/06:  THIS IS THE AREA APPROXIMATELY WHERE THE EXCEL SPREADSHEET SHOULD CLOSE
If HoldStrTemplate = "Generic" Then GoTo GenericProcessing
If HoldStrTemplate = "Generic CMS" Then GoTo GenericProcessing
'If HoldStrTemplate = "Generic CMS" Then GoTo GenericProcessing

GoTo FinishdMerge
    
'If HoldStrTemplate <> "Generic" Or HoldStrTemplate <> "Generic CMS" Then GoTo FinishdMerge
'ORIGINAL STATEMENT:  ME:  9/9/2008
'If HoldStrTemplate <> "Generic" Then GoTo FinishdMerge
GenericProcessing:
''Generic' document processing follows
'pubCopyPermitDoc is a variable located in GenMods module
'it is primed in form fLetterPInsp when the Generic document
'is selected and when there is a valid document to copy
If IsNull(pubCopyPermitDoc) Then GoTo FinishdMerge
Dim strPermitDoc
'pubPermitDocFolder is a constant located in GenMods module
strPermitDoc = pubPermitDocFolder & pubCopyPermitDoc
'open the permit document and copy its contents to the clipboard
Set wDoc = wApp.Documents.Open(strPermitDoc)
wDoc.Select
wApp.Selection.Copy
'close the permit document
wDoc.Close (wdDoNotSaveChanges)
'locate and select "PermitInfoHere" text in the
'open (merged) document
With wApp.Selection.Find
    .Forward = True
    .ClearFormatting
    .MatchWholeWord = True
    .MatchCase = False
    .Wrap = wdFindContinue
    .Execute FindText:="PermitInfoHere"
End With
On Error GoTo dMergeError
'paste the contents of the clipboard over the current selected text
wApp.Selection.Paste
'2/25/05 ME:  add the following statement-see if it will give another case
On Error GoTo dMergeError
'set permit variable to null in prep for next 'generic' call
' pubCopyPermitDoc = Null
pubCopyPermitDoc = ""
FinishUpDoc:
'place cursor at top of document
wApp.Selection.GoTo What:=wdGoToLine, which:=wdGoToAbsolute, Count:=1
'select and copy a small amount of data to the clipboard
'this is done because otherwise user would have to answer a Windows-
'generated question on having to keep a large amount of data in the
'clipboard.
wApp.ActiveDocument.Characters(1).Select
wApp.Selection.Copy
FinishdMerge:
'show document in maximized window
'pubSaveAsFolder is a constant located in the GenMods module
wApp.Options.DefaultFilePath(wdDocumentsPath) = pubSaveAsFolder & strFolder
wApp.Visible = True
wApp.WindowState = wdWindowStateMaximize
Exit_Here:
DoCmd.Hourglass False
Exit Function
dMergeError:
DoCmd.Hourglass False
Select Case Err.Number
    Case 3265
        MsgBox ("Query named " & StrQuery & " cannot be located.")
    Case 5174
        MsgBox ("Word doc named " & StrTemplate & " cannot be located.")
        ActiveDocument.Close
    Case 5922
        MsgBox ("Data transferred to Word cannot contain quotes!")
            ActiveDocument.Close SaveChanges:=wdPromptToSaveChanges, OriginalFormat:=wdPromptUser
    Case Else
        MsgBox ("error # " & Err.Number & Err.Description)
End Select
Resume Exit_Here
End Function

Public Function CloseDoc()
'ActiveWindow.Close SaveChanges:=wdSaveChanges

'This example prompts the user to save the active document before closing it. If the user clicks Cancel, error 4198 (command failed) is trapped and a message is displayed.

On Error GoTo errorHandler
ActiveDocument.Close SaveChanges:=wdPromptToSaveChanges, OriginalFormat:=wdPromptUser
errorHandler:
If Err = 4198 Then MsgBox "Document was not closed"

End Function



Public Function copymerge()
Dim StrTemplate
StrTemplate = "Generic.doc"
Dim StrQuery
StrQuery = "mqtest"
Dim strFolder
strFolder = "Junk"
Dim strPermitDoc
strPermitDoc = "30004004af 001.doc"
Const pubPermitFolder As String = "D:\bakerw\"   '"d:\bakerw\WordConv\Finished\"
strPermitDoc = pubPermitFolder & strPermitDoc
DoCmd.Hourglass True
Const pubTemplateFolder As String = "D:\bakerw\Templates\"   '"d:\bakerw\WordConv\Finished\"
If pubCurrDBPath = "" Then Call genCurrDBPath
StrTemplate = pubTemplateFolder & StrTemplate
If StrQuery = "none" Then GoTo SkipQuery
'Run query
Dim dbs As DAO.Database, rst As DAO.Recordset, qdf As DAO.QueryDef
Dim N As Integer
Dim StrDataDoc As String
StrDataDoc = pubCurrDBPath & "WDmerge.xls"
' delete current Word data file.
' ignore error if file doesn't exist
On Error Resume Next
Kill StrDataDoc
On Error GoTo 0
Set dbs = CurrentDb
On Error GoTo dMergeError
Set qdf = dbs.QueryDefs(StrQuery)
' the next bit just checks that there is data to merge
' iterate parameters collection and evaluate each parameter
For N = 0 To qdf.Parameters.Count - 1
qdf.Parameters(N) = Eval(qdf.Parameters(N).Name)
Next N
Set rst = qdf.OpenRecordset
' exit function if recordset is empty
If rst.EOF Then
    MsgBox "No data to merge.", vbInformation, "Mail Merge"
    DoCmd.Hourglass False
    GoTo Exit_Here
End If
rst.Close
qdf.Close
SkipQuery:
Dim wApp As New Word.Application
Dim wDoc As Word.Document
' create new Word data file
On Error GoTo dMergeError

' open word merge document

Set wDoc = wApp.Documents.Open(StrTemplate)
Dim strSampleFile
strSampleFile = pubCurrDBPath & "Sample.doc"
'wDoc.SaveAs FileName:=strSampleFile
If StrQuery = "none" Then GoTo FinishdMerge
On Error GoTo dMergeError
'DoCmd.TransferText acExportMerge, , strQuery, strDataDoc
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, StrQuery, StrDataDoc, True
' execute merge
'Documents("Sales.doc").MailMerge.EditDataSource

With wDoc.MailMerge
.MainDocumentType = wdFormLetters
.SuppressBlankLines = True
.Destination = wdSendToNewDocument
'.OpenDataSource Name:=strDataDoc, Format:=wdOpenFormatText, LinkToSource:=False
.OpenDataSource Name:=StrDataDoc, Format:=wdOpenFormatAuto, LinkToSource:=False, Connection:="Entire Spreadsheet"
'.OpenDataSource Name:=strDataDoc, ReadOnly:=True, Connection:="Entire Spreadsheet"

'AQMergeSource

.Execute
End With
wDoc.Close (wdDoNotSaveChanges)
'Open and copy permit document
Set wDoc = wApp.Documents.Open(strPermitDoc)
wDoc.Select
wApp.Selection.Copy
wDoc.Close (wdDoNotSaveChanges)
With Selection.Find
    .Forward = True
    .ClearFormatting
    .MatchWholeWord = True
    .MatchCase = False
    .Wrap = wdFindContinue
    .Execute FindText:="PermitInfoHere"
End With
On Error GoTo dMergeError
wApp.Selection.Paste
'close the merge 'main document' without saving

FinishdMerge:
' show document in maximized window
DoCmd.Hourglass False
wApp.Options.DefaultFilePath(wdDocumentsPath) = "d:\bakerw\" & strFolder
wApp.Visible = True
wApp.WindowState = wdWindowStateMaximize
Exit_Here:
Exit Function
dMergeError:
DoCmd.Hourglass False

Select Case Err.Number
    Case 3265
        MsgBox ("Query named " & StrQuery & " cannot be located.")
    Case 5174
        MsgBox ("Word doc named " & StrTemplate & " cannot be located.")
        ActiveDocument.Close
    Case 5922
        MsgBox ("Data transferred to Word cannot contain quotes!")
            ActiveDocument.Close SaveChanges:=wdPromptToSaveChanges, OriginalFormat:=wdPromptUser
    Case Else
        MsgBox ("error # " & Err.Number & Err.Description)
End Select
Resume Exit_Here

End Function
Public Function GetWordPermit(strPermitName)

'original before 6/6/07
'Public Function GetWordPermit(strPermitDoc)
Dim strPermitDoc
Dim strPermitPDF As String
strPermitDoc = strPermitName & ".doc"
strPermitPDF = strPermitName & ".pdf"
DoCmd.Hourglass True
'pubPermitFolder is a constant located in the GenMods module
With Application.FileSearch
    .NewSearch
    .LookIn = pubPermitFolder
    .SearchSubFolders = False
    .FileName = strPermitDoc
    .MatchTextExactly = True
    .FileType = msoFileTypeWordDocuments
    If .Execute() = 0 Then
        MsgBox ("There is no Word permit document for this Permit No")
        DoCmd.Hourglass False
        'Exit Function
        GoTo GetPDF
    End If
End With
'gets here if a Word Permit Document
strPermitDoc = pubPermitFolder & strPermitDoc
Dim wApp As New Word.Application
Dim wDoc As Word.Document
' create new Word data file
On Error GoTo dMergeError
' open word merge document
Set wDoc = wApp.Documents.Open(strPermitDoc)
wApp.Visible = True
wApp.WindowState = wdWindowStateMaximize
ExitWord_Here:
DoCmd.Hourglass False
Exit Function
dMergeError:
Select Case Err.Number
    Case 5174
        MsgBox ("Word doc named " & strPermitDoc & " cannot be located.")
    Case Else
        MsgBox ("error # " & Err.Number & Err.Description)
End Select
Resume ExitWord_Here
'-----------------P D F    STUFF
'to adapt from Get PDFInsp
GetPDF:
With Application.FileSearch
    .NewSearch
    .LookIn = pubPermitFolder
    .SearchSubFolders = True
    .FileName = strPermitPDF
    
    .MatchAllWordForms = True

    .FileType = msoFileTypeAllFiles
    If .Execute() = 0 Then
        DoCmd.Hourglass False
        MsgBox ("Permit Document" & strPermitName & " does not exist.")
            
   
    Else
        'YOU GET HERE IF IT FINDS SOMETHING
        'KeyCode = 0
        
        'Display the Files *ProjectNum.Doc
            Dim i As Integer
            Dim ActualPermitPDF 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
                ActualPermitPDF = .FoundFiles(i)
                GoTo BRINGUP_THE_PDF_DOCUMENT
                'End If
            Next i
                
    End If
End With
BRINGUP_THE_PDF_DOCUMENT:

On Error GoTo PDFOpenErr

    Dim stAppName As String
    'ME: 1/31/07:
    Dim wPDF As String

    stAppName = "C:\Program Files\Adobe\Reader 9.0\Reader\Reader\AcroRd32.exe"
    
    wPDF = stAppName & " " & ActualPermitPDF
    
    Call Shell(wPDF, 1)
ExitPDF_Here:
    DoCmd.Hourglass False
Exit Function
    

PDFOpenErr:
    MsgBox Err.Description
    Resume ExitPDF_Here
    
End Function
'----------------------
'End Function

Public Function GetWordComplaint(strComplaintDoc, Response, GotIt, DocSource)
DoCmd.Hourglass True
'pubComplaintDocFolder 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 Complaint 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
Dim FolderSource As String
  If DocSource = "cmp" Then
      FolderSource = pubComplaintDocFolder
  Else
      FolderSource = pubInspDocFolder
  End If
  If Dir(FolderSource & "\" & strComplaintDoc) = "" Then
    DoCmd.Hourglass False
    If Response = "edit" Then
        GotIt = 1
        MsgBox ("Complaint document " & strComplaintDoc & " does not exist in Word.  If you need to create one, go to the 'Merge' icon.")
    End If
    Exit Function
  Else
    'KeyCode = 0
    'ME: 7/11/03 - add code so it knows which control got you in here: new merge or edit
    If Response <> "edit" Then
        Response = MsgBox("The Document " & strComplaintDoc & " has previously been merged-Do You Want To MERGE Anyway?", vbYesNo)
        'ME: 7/11/03 - take out the following line and exit regardless of response
        '        we don't need to bring up the existing document from the "Create" button (consistency)
        'If response = vbYes Then GoTo Exit_Here
        GoTo Exit_Here
    End If
  End If


  strComplaintDoc = pubComplaintDocFolder & strComplaintDoc
  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(strComplaintDoc)
  wApp.Visible = True
  wApp.WindowState = wdWindowStateMaximize
Exit_Here:
DoCmd.Hourglass False
Exit Function
dMergeError:
Select Case Err.Number
    Case 5174
        MsgBox ("Word doc named " & strComplaintDoc & " 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

'rpg 2015Mar24
'rewrite FileSearch code
'Look in FolderSource/strInspDoc
'Beginning of new code -------------------------------------------------------------------

'rpg Commented out with End With below
'With Application.FileSearch
'    .NewSearch
'    .LookIn = FolderSource
'    .SearchSubFolders = True
'    .FileName = strInspDoc
'    .MatchAllWordForms = True
'    .FileType = msoFileTypeWordDocuments
    
'rpg Check to see if the file exists
Dim strFileName, strDirFileThere As String
strFileName = FolderSource & strInspDoc
strDirFileThere = Dir(strFileName)
    If strDirFileThere = "" Then
        DoCmd.Hourglass False
        MsgBox "There is no document"
        Exit Function
    Else
        DoCmd.Hourglass False
        Dim i As Integer
        Dim ActualInspDoc As String
        GoTo BRINGUP_THEDOCUMENT
    End If
'rpg commented out
'    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
'End of new code ---------------------------------------------------------------

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
'rpg changed ActualInspDoc to strFileName
Set wDoc = wApp.Documents.Open(strFileName)
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 GetPDFInsp(strInspPDF, Response, GotIt, DocSource)
'1/31/07:  ME:  COPIED FROM GetWordInsp....

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
    ElseIf DocSource = "cmp" Then
        FolderSource = pubComplaintDocFolder
    Else
        FolderSource = pubInspDocFolder
    End If
With Application.FileSearch
    .NewSearch
    .LookIn = FolderSource
    .SearchSubFolders = True
    .FileName = strInspPDF
    .MatchAllWordForms = True
    
    '.FileType = msoFileTypeWordDocuments
    'ME:  02/01/2007:  or possibly the following
    .FileType = msoFileTypeAllFiles
    If .Execute() = 0 Then
        DoCmd.Hourglass False
        If Response = "edit" Then
            If GotIt = 1 Then
                GotIt = 2
                'MsgBox ("Inspection document " & strInspPDF & " does not exist.")
            End If
        End If
        Exit Function
    Else
        'YOU GET HERE IF IT FINDS SOMETHING
        'KeyCode = 0
        
        'Display the Files *ProjectNum.Doc
            Dim i As Integer
            Dim ActualInspPDF 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
                ActualInspPDF = .FoundFiles(i)
                GoTo BRINGUP_THE_PDF_DOCUMENT
                'End If
            Next i
                
    End If
End With
BRINGUP_THE_PDF_DOCUMENT:

On Error GoTo PDFOpenErr

    Dim stAppName As String
    'ME: 1/31/07:
    Dim wPDF As String

    stAppName = "C:\Program Files\Adobe\Reader 9.0\Reader\AcroRd32.exe"
    wPDF = stAppName & " " & ActualInspPDF
    
    Call Shell(wPDF, 1)
Exit_Here:
    DoCmd.Hourglass False
Exit Function
    

PDFOpenErr:
    MsgBox Err.Description
    Resume Exit_Here
    
End Function

 

[zandsc1]

Well that's a good sized module to wade through looking for errors...

So is this the actual line that's throwing the error:

Call dmerge(WordDoc, MergeQuery, SaveFolder)

Or is it somewhere within the dmerge function that you posted? If it's the actual 'Call dmerge...' line that's giving an error, it would make me think that Access isn't even able to start the process of running the dmerge function, i.e. something is wrong with your call parameters. You may want to try changing it to simply

dmerge(WordDoc, MergeQuery, SaveFolder)

and eliminate the 'Call' (it shouldn't be necessary). Also verify that your variables WordDoc, MergeQuery, and SaveFolder have all been properly set and are all string types since that is what your dmerge function is looking for.

 

[tlallen]

dmerge generates the errror. The thre issues are:

Excel will not open. Run.application no longer works in Access 2016 and I do not know how to write a macro to replace the Run.application Macro for Excel.

Dim CR
CR = Chr(13)

is not defined (ex. AS string, object or ???? ) I do not know what to define it as in Access 2016.

The .fileSearch command gives an error in 2016 and I found on Tek-Tips the .filesearch command no longer works in Access 2016, but I do not know how to re-write this part of the code.

If I can figure out the code for these three issues, the code to use in Access 2016, the merge should run.

 

[zandsc1]

Chr(13) is to use ASCII to reference the carriage return character. I think if you define CR as a string you'll resolve that issue.

Opening and searching through excel is not as easy a fix, unfortunately. Excel has it's own class now with it's own set of commands which is a nice improvement, but a pain for those of us who setup our systems to run with the old way of doing things. I think you'll find some useful information in this thread about how to open up and do things with excel documents from Access VBA.

https://social.msdn.microsoft.com/F...ing-an-excel-file-from-ms-access?forum=isvvba