Function for checking and opening a workbook

Hi Team,

I use below code to check files in a folder and open correct file.

Can we shorten below code, by Creating one time function:help

Step1 User will select date and Product Name (MTO) on a calender.
in excel Complete file path will get generated. with some formula.

Code:

---

Sub Check_File_and Open()
    frmInput.Show
    wsFolderPath.Range("I1").Value = dtReportDate
    wsFolderPath.Range("J1").Value = strMTOName
    Path = wsFolderPath.Range("B2").Value
    Keyword = strMTOName & " Debtor Report"
    'Check File and Open Debtor workbook
    strFile = Dir(Path & "\*" & Keyword & "*.xls*")
    If strFile <> "" Then
        Application.DisplayAlerts = False
        Set wbk_Debtor = Workbooks.Open(Path & "\" & strFile, False, True)
        Application.DisplayAlerts = True
    Else
        MsgBox "Workbook :- " & Keyword & " not found in a Folder " & Path, vbCritical, "Select Correct Date or Check Files in A Folder"
        GoTo Myend
    End If
    'Check File and Open Creditor
    Keyword = strMTOName & " Creditor"
    strFile = Dir(Path & "\*" & Keyword & "*.xls*")
    If strFile <> "" Then
        Application.DisplayAlerts = False
        Set wbk_Creditor = Workbooks.Open(Path & "\" & strFile, False, True)
        Application.DisplayAlerts = True
    Else
        MsgBox "Workbook :- " & Keyword & " not found in a Folder " & Path, vbCritical, "Select Correct Date or Check Files in A Folder"
        GoTo Myend
    End If
    'Check Sales1 Workbook and Open
    Keyword = strMTOName & " Sales Register 001"
    strFile = Dir(Path & "\*" & Keyword & "*.xls*")
    If strFile <> "" Then
        Application.DisplayAlerts = False
        Set wbk_Sales1 = Workbooks.Open(Path & "\" & strFile, False, True)
        Application.DisplayAlerts = True
    Else
        MsgBox "Workbook :- " & Keyword & " not found in a Folder " & Path, vbCritical, "Select Correct Date or Check Files in A Folder"
        GoTo Myend
    End If
    'Check File Sales2 Workbook
    Keyword = strMTOName & " Sales Register 002"
    strFile = Dir(Path & "\*" & Keyword & "*.xls*")
    If strFile <> "" Then
        Application.DisplayAlerts = False
        Set wbk_Sales2 = Workbooks.Open(Path & "\" & strFile, False, True)
        Application.DisplayAlerts = True
    Else
        MsgBox "Workbook :- " & Keyword & " not found in a Folder " & Path, vbCritical, "Select Correct Date or Check Files in A Folder"
        GoTo Myend
    End If
    'myend:
    'I am closing all workbook here, setting object to nothing
End Sub

---

Something like this?

Not Tested

Code:

---

Option Explicit


Sub Check_File_and_Open()
   
    frmInput.Show
       
    wsFolderPath.Range("I1").Value = dtReportDate
    wsFolderPath.Range("J1").Value = strMTOName
     
    Path = wsFolderPath.Range("B2").Value


    '============ Check File and Open Debtor workbook========================
    Set wbk_Debtor = OpenTheFile(Path, strMTOName & " Debtor Report")
    If wbk_Debtor Is Nothing Then GoTo MyEnd
 
    '===============Check File and Open Creditor===============
    Set wbk_Creditor = OpenTheFile(Path, strMTOName & " Creditor")
    If wbk_Creditor Is Nothing Then GoTo MyEnd
           
  '====================Check Sales1 Workbook and Open==============================
 
    Set wbk_Sales1 = OpenTheFile(Path, strMTOName & " Sales Register 001")
    If wbk_Sales1 Is Nothing Then GoTo MyEnd


  '====================Check File Sales2 Workbook==============================
    Set wbk_Sales2 = OpenTheFile(Path, strMTOName & " Sales Register 002")
    If wbk_Sales2 Is Nothing Then GoTo MyEnd


MyEnd:
    'stuff
End Sub

Private Function OpenTheFile(P As String, KW As String) As Workbook
    Dim strFile As String
   
    strFile = Dir(P & "\*" & KW & "*.xls*")
    If strFile <> "" Then
        Application.DisplayAlerts = False
        Set OpenTheFile = Workbooks.Open(P & Application.PathSeparator & strFile, False, True)
        Application.DisplayAlerts = True
    Else
        MsgBox "Workbook :- " & KW & " not found in a Folder " & P, vbCritical, "Select Correct Date or Check Files in A Folder"
        Set OpenTheFile = Nothing
    End If


End Function

---

or

Code:

---

Option Explicit


Sub Check_File_and_Open2()
   
    frmInput.Show
       
    wsFolderPath.Range("I1").Value = dtReportDate
    wsFolderPath.Range("J1").Value = strMTOName
     
    Path = wsFolderPath.Range("B2").Value


    If Not OpenTheFile2(wbk_Debtor, Path, strMTOName & " Debtor Report") Then GoTo MyEnd
    If Not OpenTheFile2(wbk_Creditor, Path, strMTOName & " Debtor Report") Then GoTo MyEnd
    If Not OpenTheFile2(wbk_Sales1, Path, strMTOName & " Debtor Report") Then GoTo MyEnd
    If Not OpenTheFile2(wbk_Sales2, Path, strMTOName & " Debtor Report") Then GoTo MyEnd
 


MyEnd:
    'stuff
End Sub




Private Function OpenTheFile2(ByRef WB As Workbook, P As String, KW As String) As Boolean
    Dim strFile As String
   
    strFile = Dir(P & "\*" & KW & "*.xls*")
    If strFile <> "" Then
        Application.DisplayAlerts = False
        Set WB = Workbooks.Open(P & Application.PathSeparator & strFile, False, True)
        Application.DisplayAlerts = True
        OpenTheFile2 = True
    Else
        MsgBox "Workbook :- " & KW & " not found in a Folder " & P, vbCritical, "Select Correct Date or Check Files in A Folder"
        OpenTheFile2 = False
    End If


End Function

---

Hi Paul,

Perfect !! Thanks for your help, it worked.

one more help required. Before opening these files how to check,
are these files are opened. if opened, Intimate plz close the file and exit sub:thumb

Code:

---

Set wbk_Debtor = OpenTheFile(Path, strMTOName & " Debtor Report")
If wbk_Debtor Is Nothing Then GoTo MyEnd

---

Thanks
mg

Use a simple loop.

You can try this version --


You have a "*" in your filename after the "" to look for. Do you really need it?

Code:

---

        P & "\*" & KW & "*.xls*" Then

---

Seems to me that this would be better if you can use it

Code:

---

        P & "\" & KW & "*.xls*" Then

---

This would find "C:\Users\Tom\Documents\MTO Sales.xls" but not

"C:\Users\Tom\Documents\2020-01-25 MTO Sales.xls" or "C:\Users\Tom\Documents\2020-06-01 MTO Sales.xls"

Code:

---

Option Explicit


Private Function OpenTheFile(P As String, KW As String) As Workbook
    Dim strFile As String
    Dim wb As Workbook
   
    Set OpenTheFile = Nothing
   
    For Each wb In Application.Workbooks
        If wb.FullName Like P & "\*" & KW & "*.xls*" Then
            wb.Close False
            MsgBox "Workbook :- " & KW & " was already open " & P, vbCritical, "Select Correct Date or Check Files in A Folder"
            Set OpenTheFile = Nothing
            Exit Function
        End If
    Next
   
   
    strFile = Dir(P & "\*" & KW & "*.xls*")
    If strFile <> "" Then
        Application.DisplayAlerts = False
        Set OpenTheFile = Workbooks.Open(P & Application.PathSeparator & strFile, False, True)
        Application.DisplayAlerts = True
        Exit Function
    End If
       
    MsgBox "Workbook :- " & KW & " not found in a Folder " & P, vbCritical, "Select Correct Date or Check Files in A Folder"
End Function

---

Hi Paul,

Amazing ! Millions of thanks for your help. it worked. :thumb:bow:


Thanks
mg

This code should be in the userform frmInput
This code suffices:

Code:

---

Sub M_snb()
    For Each it In Workbooks
      c00 = c00 & "|" & it.Name
    Next
    c01 = Range("B2")
   
    For j = 1 To 4
      c02 = strMTOName & Choose(j, " Debtor Report", " Creditor", " Sales Register 001", " Sales Register 002")
      If InStr(c00 & "|", "|" & c02 & "|") = 0 And Dir(c01 & "\" & c02) <> "" Then Workbooks.Open c02
    Next
End Sub

---