How to search for latest file in folder and if not found then open dialog box with restrictions-CodePudding

So basically the goal is to combine these to functions into one or make it compatible with each other cause atm there is errors when it comes to the part when the path of the chosen file is not refer to in the same manner as the path of the found file within the loop if available in the folder.

So I know why I'm getting the error please see below 'HERE IS WHERE I GET THE ERROR' but I cant write the proper code to find my way out of the situation.

'main code that run is doing something like search for file within folder,
'loop and get the latest file and generates a path and name for next
'function which is to copy a sheet from the found file over to the main
'workbook and so.

'What I'm trying to to is to build a failsafe, lets say file is not pushed
'or placed whin this predestinated folder, then instead of doing nothing,
'dialog box opens up and files gets chosen instead.


Option Explicit

Sub ImportAndFormatData()
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
Const sFolderPath As String = "C:\Temp\"
    
    'Search for newest file
    
    Dim sFileName As String: sFileName = Dir(sFolderPath & "_pr11*.xlsx")
    If Len(sFileName) = 0 Then Call OpenDialogBox
    
    Dim cuDate As Date, sFileDate As Date, cuPath As String, sFilePath As String
    
    Do Until Len(sFileName) = 0
        cuPath = sFolderPath & sFileName
        cuDate = FileDateTime(cuPath)
        'Debug.Print "Current:  " & cuDate & "  " & cuPath ' print current
        If cuDate > sFileDate Then
            sFileDate = cuDate
            sFilePath = cuPath
        End If
        sFileName = Dir
    Loop
    'Debug.Print "Result:   " & sFileDate & "  " & sFilePath ' print result
    

    'Open newest file - HERE IS WHERE I GET THE ERROR
    Dim closedBook As Workbook: Set closedBook = Workbooks.Open(sFilePath)
    closedBook.Sheets("Analyse").Copy After:=ThisWorkbook.Sheets("PR11_P3")
    closedBook.Close SaveChanges:=False

'code dose not end here but that part don't need to be included here since
'its just formatting

End Sub

And here is function for OpenDialogBox, I'm tying to enforce just a specific titel (cause only this file/rapport is correct source for the entire code (or rather rest of the code) but I cant figure this part out either, please see below, GIVES ERROR DOSENT WORK)

Sub OpenDialogBox()

    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
        .Filters.Clear
        .Title = "Välj valfri PR11"
        .Filters.Add "Excel filer", "_pr11*.xlsx?", 1 'GIVES ERROR DOSENT WORK
        .AllowMultiSelect = False
    
        If .Show = True Then
            Debug.Print .SelectedItems(1)
            Debug.Print Dir(.SelectedItems(1))
        End If
    End With

End Sub

CodePudding user response：

This combines both the Dir() and FileDialog approaches:

Sub ImportAndFormatData()
    Dim fSelected As String, wb As Workbook

    fSelected = InputFile()
    If Len(fSelected) > 0 Then
        Set wb = Workbooks.Open(fSelected)
        wb.Sheets("Analyse").Copy After:=ThisWorkbook.Sheets("PR11_P3")
        wb.Close False
    End If
End Sub

Function InputFile() As String
    Const SRC_FOLDER As String = "C:\Temp\"
    Dim f, fSelected As String, latestDate As Date, fdt
    
    f = Dir(SRC_FOLDER & "*_pr11*.xlsx") 'first check the configured folder for a match
    If Len(f) > 0 Then
        'found matching file at specified path: loop for the newest file
        Do While Len(f) > 0
            fdt = FileDateTime(SRC_FOLDER & f)
            If fdt > latestDate Then
                fSelected = SRC_FOLDER & f
                latestDate = fdt
            End If
            f = Dir()
        Loop
        InputFile = fSelected
    Else
        'no match at specified path - allow user selection
        With Application.FileDialog(msoFileDialogFilePicker)
            .Filters.Clear
            .Title = "Välj valfri PR11"
            .Filters.Add "Excel filer", "*.xlsx" 'filter only allows extension: no filename wildcards...
            .AllowMultiSelect = False
            If .Show Then InputFile = .SelectedItems(1)
        End With
    End If
End Function