Macro to convert Files into CSV Files-limit selection when browsing

[howard]

I need to amend the code below so that only the latest files like "Rsqm_Listofinventory_Inquiry" with .xlsx are displayed in the c:\Pull folder eg Rsqm_Listofinventory_Inquiry 885794.xlsx before converting these to .csv files. The code works perfectly but I have to select the files from Many other files. I want to limit the selection

When running the code, it is not limiting selection in the folder to display the latest modifed files like "Rsqm_Listofinventory_Inquiry" with a .xlsx extension

 Sub ConvertToCSVtest()


    Dim objFD As FileDialog
    Dim lngNumTabs As Long
    Dim lngCounter As Long
    Dim strFile As String
    Dim wbkToOpen As Workbook
    Dim wksTab As Worksheet
    Dim selectedFile As String
   
    ' Find the latest modified file matching the specified criteria
    selectedFile = GetLatestFile("C:\Pull\", ""Rsqm_Listofinventory_Inquiry", ".xlsx")
   
    If selectedFile = "" Then
        MsgBox "No matching files found.", vbExclamation
        Exit Sub
    End If

    Set objFD = Application.FileDialog(msoFileDialogFilePicker)
    With objFD
        .AllowMultiSelect = True
        .Title = "Select Files"
        .InitialFileName = selectedFile
        .Filters.Clear
        .Filters.Add "Excel files", "*.xls*"
        If .Show = -1 Then
            With Application
                .DisplayAlerts = False
                .ScreenUpdating = False
            End With
            For lngCounter = 1 To objFD.SelectedItems.Count
                Set wbkToOpen = Workbooks.Open(objFD.SelectedItems(lngCounter))
                strFile = Left(wbkToOpen.FullName, InStrRev(wbkToOpen.FullName, ".") - 1)
                If wbkToOpen.Sheets.Count > 1 Then
                    lngNumTabs = 1
                    For Each wksTab In wbkToOpen.Worksheets
                        wksTab.Copy
                        ActiveWorkbook.SaveAs Filename:=strFile & "-" & lngNumTabs _
                            & ".csv", FileFormat:=xlCSV, CreateBackup:=False
                        ActiveWorkbook.Close False
                        lngNumTabs = lngNumTabs + 1
                    Next wksTab
                    wbkToOpen.Close False
                Else
                    wbkToOpen.SaveAs Filename:=strFile & ".csv", FileFormat:=xlCSV, CreateBackup:=False
                    wbkToOpen.Close False
                End If
            Next lngCounter
        End If
    End With

    Set wbkToOpen = Nothing

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

End Sub

Function GetLatestFile(folderPath As String, fileNamePrefix As String, fileExtension As String) As String
    Dim latestFile As String
    Dim latestDate As Date
   
    latestFile = ""
    latestDate = DateSerial(1900, 1, 1)
   
    Dim file As Variant
    file = Dir(folderPath & fileNamePrefix & "*" & fileExtension)
   
    Do While file <> ""
        If file Like fileNamePrefix & "*" & fileExtension Then
            If FileDateTime(folderPath & file) > latestDate Then
                latestFile = folderPath & file
                latestDate = FileDateTime(folderPath & file)
            End If
        End If
        file = Dir
    Loop
   
    GetLatestFile = latestFile
End Function [code]

 

[howard]

I have managed to get it to work -see code below

 Sub ConvertToCSVLatestmodified()
Application.ScreenUpdating = False
    Dim strFolderPath As String
    Dim selectedFiles() As String
    Dim selectedFile As Variant
    
    ' Specify the folder path
    strFolderPath = "C:\Pull\"
    
    ' Find the latest modified files matching the specified criteria
    selectedFiles = GetLatestFiles(strFolderPath, "Rsqm_Listofinventory_Inquiry", ".xlsx")
    
    If UBound(selectedFiles) = -1 Then
        MsgBox "No matching files found.", vbExclamation
        Exit Sub
    End If

    ' Rest of the code remains unchanged
    Set objFD = Application.FileDialog(msoFileDialogFilePicker)
    With objFD
        .AllowMultiSelect = True
        .Title = "Select Files"
        .InitialFileName = selectedFiles(0) ' Use the first file as the initial file name
        .Filters.Clear
        .Filters.Add "Excel files", "*.xls*"
        
        If .Show = 0 Then Exit Sub
        
        For Each selectedFile In .SelectedItems
            Set wbkToOpen = Workbooks.Open(selectedFile)
            
            ' Process the workbook
            With Application
                .DisplayAlerts = False
                .ScreenUpdating = False
            End With
            
            ' Check if there are multiple sheets in the workbook
            If wbkToOpen.Sheets.Count > 1 Then
                lngNumTabs = 1
                For Each wksTab In wbkToOpen.Worksheets
                    wksTab.Copy
                    ActiveWorkbook.SaveAs Filename:=Left(wbkToOpen.FullName, InStrRev(wbkToOpen.FullName, ".") - 1) & "-" & lngNumTabs & ".csv", FileFormat:=xlCSV, CreateBackup:=False
                    ActiveWorkbook.Close False
                    lngNumTabs = lngNumTabs + 1
                Next wksTab
            Else
                ' Save the single-sheet workbook as CSV
                wbkToOpen.SaveAs Filename:=Left(wbkToOpen.FullName, InStrRev(wbkToOpen.FullName, ".") - 1) & ".csv", FileFormat:=xlCSV, CreateBackup:=False
            End If
            
            ' Close the original workbook without saving changes
            wbkToOpen.Close False
            
            ' Restore application settings
            With Application
                .ScreenUpdating = True
                .DisplayAlerts = True
            End With
        Next selectedFile
    End With

    Set wbkToOpen = Nothing
    Application.ScreenUpdating = False

End Sub

Function GetLatestFiles(folderPath As String, fileNamePrefix As String, fileExtension As String) As String()
    Dim latestFiles() As String
    Dim latestDate As Date
    Dim file As String
    Dim fileCount As Long

    latestDate = DateSerial(1900, 1, 1)

    ' Count the number of matching files
    file = Dir(folderPath & fileNamePrefix & "*" & fileExtension)
    Do While file <> ""
        If file = fileNamePrefix & fileExtension Then
            If FileDateTime(folderPath & file) > latestDate Then
                latestDate = FileDateTime(folderPath & file)
                fileCount = 1
            ElseIf FileDateTime(folderPath & file) = latestDate Then
                fileCount = fileCount + 1
            End If
        End If
        file = Dir
    Loop

    ' Populate the array with matching files
    ReDim latestFiles(0 To fileCount - 1)
    file = Dir(folderPath & fileNamePrefix & "*" & fileExtension)
    Do While file <> ""
        If file = fileNamePrefix & fileExtension And FileDateTime(folderPath & file) = latestDate Then
            latestFiles(fileCount - 1) = folderPath & fileNamePrefix & "*" & fileExtension
            fileCount = fileCount - 1
        End If
        file = Dir
    Loop

    GetLatestFiles = latestFiles
End Function