如何在文件夹中搜索最新文件，如果找不到则打开有限制的对话框

Question

所以基本上目标是将这些功能组合成一个或使它们相互兼容，因为当涉及到所选文件的路径未以相同方式引用时，atm 会出现错误作为在循环中找到的文件的路径（如果在文件夹中可用）。

所以我知道为什么会出现错误，请参阅下文 'HERE IS WHERE I GET THE ERROR' 但我无法编写正确的代码来摆脱这种情况。

'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

这里是 OpenDialogBox 的函数，我想强制执行一个特定的标题（因为只有这个 file/rapport 是整个代码（或者更确切地说是代码的其余部分）的正确来源，但我无法确定这部分要么，请看下面，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

Answer 1

这结合了 Dir() 和 FileDialog 方法：

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

如何在文件夹中搜索最新文件，如果找不到则打开有限制的对话框

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

excel

vba