PDA

View Full Version : [SOLVED:] Function for checking and opening a workbook



malleshg24
10-17-2020, 05:50 PM
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.


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

Paul_Hossler
10-18-2020, 08:13 AM
Something like this?

Not Tested



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




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

malleshg24
10-19-2020, 02:57 AM
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


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


Thanks
mg

snb
10-19-2020, 04:00 AM
Use a simple loop.

Paul_Hossler
10-19-2020, 08:03 AM
You can try this version --


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



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



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



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"





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

malleshg24
10-19-2020, 06:40 PM
Hi Paul,

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


Thanks
mg

snb
10-20-2020, 12:20 AM
This code should be in the userform frmInput
This code suffices:


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