Consulting

Results 1 to 7 of 7

Thread: VBA help - Function for checking and opening a workbook

  1. #1
    Banned VBAX Contributor
    Joined
    Aug 2017
    Posts
    144
    Location

    VBA help - 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


    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

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    Last edited by Paul_Hossler; 10-18-2020 at 08:33 AM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Banned VBAX Contributor
    Joined
    Aug 2017
    Posts
    144
    Location
    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

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


    Thanks
    mg
    Last edited by malleshg24; 10-19-2020 at 04:06 AM.

  4. #4
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Use a simple loop.

  5. #5
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  6. #6
    Banned VBAX Contributor
    Joined
    Aug 2017
    Posts
    144
    Location
    Hi Paul,

    Amazing ! Millions of thanks for your help. it worked.


    Thanks
    mg

  7. #7
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •