Selecting Folder Path- Not reading files within the selected folder-CodePudding

relating to my last post Here, I would like to expand this to make it so the folder path is not hard coded. I would like to make it so the user can choose what folder to use. I've found this post. I've added it to my code (of sorts) and it does take me to the folder selecting dialog and I can pick a folder. However, it is unable to read the files within- "0 .csv files found" even though there are files there. When the file path is hard coded, it will read the files. This is my code as of now (yes, it's probably awful, I have absolutely no idea how to code so I've just copy/pasted and change what I think is needed and threw this code in the beginning)

Function ChooseFolder() As String
Dim fldr As FileDialog
Dim sItem As String

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = "C:\Users\Me\Desktop\Extracted Data\"
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
End Function
Sub MergeAllWorkbooksFinal()

Dim wb As Workbook, wbCSV As Workbook
Dim ws As Worksheet, wsCSV As Worksheet
Dim rngCSV As Range, fnd As Range, bFound As Boolean
Dim Filename As String, n As Long, i As Long
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
      ' Refers to Function
Set objFolder = objFSO.GetFolder(ChooseFolder)

' Set summarysheet to activeworkbook/activesheet where the macro runs
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

' regular expression to extract numbers
' example VS SAAV_282579 ch 4 Data.csv
Dim Regex As Object, m As Object, SN As Long, CH As Long
Set Regex = CreateObject("vbscript.regexp")
With Regex
   .IgnoreCase = True
   .Pattern = "(_(\d ).* ch *(\d )  Data)"
End With

' Call Dir the first time, pointing it to all Excel files in the folder path.
Filename = Dir(objFolder & "*Data.csv*")

' Loop until Dir returns an empty string.
Application.ScreenUpdating = False
Do While Filename <> ""
    
    ' extract SN and Ch from filename
    If Regex.test(Filename) Then
        Set m = Regex.Execute(Filename)(0).submatches
        SN = m(1)
        CH = m(2)
        Debug.Print Filename, SN, CH
        
        ' Find SN
        Set fnd = ws.Range("B:B").Find(SN, LookIn:=xlValues, lookat:=xlWhole)
        If fnd Is Nothing Then
             MsgBox SN & " not found !", vbCritical, Filename
        Else
           ' find ch.
           bFound = False
           For i = 0 To fnd.MergeArea.Count - 1
                If ws.Cells(fnd.Row   i, "D") = CH Then ' Col D
                    bFound = True
                    ' Open a workbook in the folder
                    Set wbCSV = Workbooks.Open(objFolder & Filename, ReadOnly:=True)
                    ws.Cells(fnd.Row   i, "F").Resize(, 2).Value2 = wbCSV.Sheets(1).Range("B2:C2").Value2
                     ' Close the source workbook without saving changes.
                    wbCSV.Close savechanges:=False
                    Exit For
                End If
            Next
            If bFound = False Then
                MsgBox "Ch." & CH & " not found for " & SN, vbExclamation, Filename
            End If
        End If
        n = n   1
    Else
        Debug.Print Filename & " skipped"
    End If
    ' Use Dir to get the next file name.
    Filename = Dir()
Loop
    
' Call AutoFit on the destination sheet so that all
' data is readable.
ws.Columns.AutoFit
Application.ScreenUpdating = True

'Message Box when tasks are completed
MsgBox n & " csv files found.", vbInformation, "Task Complete!"

End Sub

For the original code, it's this:

Sub MergeAllWorkbooksFinal()

' Modify this folder path to point to the files you want to use. *add a '\' to end of the file name*
Const FolderPath = "C:\Users\Me\Desktop\Extracted Data\"

Dim wb As Workbook, wbCSV As Workbook
Dim ws As Worksheet, wsCSV As Worksheet
Dim rngCSV As Range, fnd As Range, bFound As Boolean
Dim Filename As String, n As Long, i As Long
   
' Set summarysheet to activeworkbook/activesheet where the macro runs
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

' regular expression to extract numbers
' example VS SAAV_282579 ch 4 Data.csv
Dim Regex As Object, m As Object, SN As Long, CH As Long
Set Regex = CreateObject("vbscript.regexp")
With Regex
   .IgnoreCase = True
   .Pattern = "(_(\d ).* ch *(\d )  Data)"
End With

' Call Dir the first time, pointing it to all Excel files in the folder path.
Filename = Dir(FolderPath & "*Data.csv*")

' Loop until Dir returns an empty string.
Application.ScreenUpdating = False
Do While Filename <> ""
    
    ' extract SN and Ch from filename
    If Regex.test(Filename) Then
        Set m = Regex.Execute(Filename)(0).submatches
        SN = m(1)
        CH = m(2)
        Debug.Print Filename, SN, CH
        
        ' Find SN
        Set fnd = ws.Range("B:B").Find(SN, LookIn:=xlValues, lookat:=xlWhole)
        If fnd Is Nothing Then
             MsgBox SN & " not found !", vbCritical, Filename
        Else
           ' find ch.
           bFound = False
           For i = 0 To fnd.MergeArea.Count - 1
                If ws.Cells(fnd.Row   i, "D") = CH Then ' Col D
                    bFound = True
                    ' Open a workbook in the folder
                    Set wbCSV = Workbooks.Open(FolderPath & Filename, ReadOnly:=True)
                    ws.Cells(fnd.Row   i, "F").Resize(, 2).Value2 = wbCSV.Sheets(1).Range("B2:C2").Value2
                     ' Close the source workbook without saving changes.
                    wbCSV.Close savechanges:=False
                    Exit For
                End If
            Next
            If bFound = False Then
                MsgBox "Ch." & CH & " not found for " & SN, vbExclamation, Filename
            End If
        End If
        n = n   1
    Else
        Debug.Print Filename & " skipped"
    End If
    ' Use Dir to get the next file name.
    Filename = Dir()
Loop
    
' Call AutoFit on the destination sheet so that all
' data is readable.
ws.Columns.AutoFit
Application.ScreenUpdating = True

'Message Box when tasks are completed
MsgBox n & " csv files found.", vbInformation, "Task Complete!"

End Sub

TL:DR: Need to make my original code have a "choose folder" function that can still read the data/files within the selected folder

EDIT: If anyone is interested, here is my final code:

Function PickFolder( _
Optional ByVal InitialFolderPath As String = "", _
Optional ByVal DialogTitle As String = "Browse", _
Optional ByVal DialogButtonName As String = "OK") _
As String
With Application.FileDialog(4) ' 4 = msoFileDialogFolderPicker
    .Title = DialogTitle
    .ButtonName = DialogButtonName
    Dim FolderPath As String
    If Len(InitialFolderPath) > 0 Then
        ' Note that the following block is NOT redundant.
        If Right(InitialFolderPath, 1) = "\" Then
            FolderPath = InitialFolderPath
        Else
            FolderPath = InitialFolderPath & "\"
        End If
        .InitialFileName = FolderPath
    End If
    If .Show Then
        FolderPath = .SelectedItems(1)
        If Right(FolderPath, 1) <> "\" Then
            FolderPath = FolderPath & "\"
        End If
        PickFolder = FolderPath
    Else
        ' Optionally, out-comment or use a message box.
        Debug.Print "'PickFolder': dialog canceled."
    End If
End With
End Function

Sub PickFolderTEST()
Const InitialFolderPath As String = "C:\Users\Me\Desktop\Extracted Data"
Dim FolderPath As String: FolderPath = PickFolder(InitialFolderPath)
If Len(FolderPath) = 0 Then Exit Sub

'Insert Cells
Range("E:G").EntireColumn.Insert
'Copy then paste cells
Range("H:J").Copy Range("E:F")
'Clear Contents
Range("F3:G1000").ClearContents

Dim wb As Workbook, wbCSV As Workbook
Dim ws As Worksheet, wsCSV As Worksheet
Dim rngCSV As Range, fnd As Range, bFound As Boolean
Dim Filename As String, n As Long, i As Long
   
' Set summarysheet to activeworkbook/activesheet where the macro runs
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

' regular expression to extract numbers
' example VS SAAV_282579 ch 4 Data.csv
Dim Regex As Object, m As Object, SN As Long, CH As Long
Set Regex = CreateObject("vbscript.regexp")
With Regex
   .IgnoreCase = True
   .Pattern = "(_(\d ).* ch *(\d )  Data)"
End With

' Call Dir the first time, pointing it to all Excel files in the folder path.
Filename = Dir(FolderPath & "*Data.csv*")

' Loop until Dir returns an empty string.
Application.ScreenUpdating = False
Do While Filename <> ""
    
    ' extract SN and Ch from filename
    If Regex.test(Filename) Then
        Set m = Regex.Execute(Filename)(0).submatches
        SN = m(1)
        CH = m(2)
        Debug.Print Filename, SN, CH
        
        ' Find SN
        Set fnd = ws.Range("B:B").Find(SN, LookIn:=xlValues, lookat:=xlWhole)
        If fnd Is Nothing Then
             MsgBox SN & " not found !", vbCritical, Filename
        Else
           ' find ch.
           bFound = False
           For i = 0 To fnd.MergeArea.Count - 1
                If ws.Cells(fnd.Row   i, "D") = CH Then ' Col D
                    bFound = True
                    ' Open a workbook in the folder
                    Set wbCSV = Workbooks.Open(FolderPath & Filename, ReadOnly:=True)
                    ws.Cells(fnd.Row   i, "F").Resize(, 2).Value2 = wbCSV.Sheets(1).Range("B2:C2").Value2
                     ' Close the source workbook without saving changes.
                    wbCSV.Close savechanges:=False
                    Exit For
                End If
            Next
            If bFound = False Then
                MsgBox "Ch." & CH & " not found for " & SN, vbExclamation, Filename
            End If
        End If
        n = n   1
    Else
        Debug.Print Filename & " skipped"
    End If
    ' Use Dir to get the next file name.
    Filename = Dir()
Loop
    
' Call AutoFit on the destination sheet so that all
' data is readable.
ws.Columns.AutoFit
Application.ScreenUpdating = True

'Message Box when tasks are completed
MsgBox n & " csv files found.", vbInformation, "Task Complete!"

End Sub

CodePudding user response：

Pick a Folder

In your code, you could utilize the PickFolder function like this:

Sub PickFolderTEST()
    Const InitialFolderPath As String = "C:\Users\Me\Desktop\Extracted Data"
    Dim FolderPath As String: FolderPath = PickFolder(InitialFolderPath)
    If Len(FolderPath) = 0 Then Exit Sub
    
    ' Continue with the code...
    MsgBox "You picked the folder '" & FolderPath & "'.", vbInformation
    
End Sub

The Function

Function PickFolder( _
    Optional ByVal InitialFolderPath As String = "", _
    Optional ByVal DialogTitle As String = "Browse", _
    Optional ByVal DialogButtonName As String = "OK") _
As String
    With Application.FileDialog(4) ' 4 = msoFileDialogFolderPicker
        .Title = DialogTitle
        .ButtonName = DialogButtonName
        Dim FolderPath As String
        If Len(InitialFolderPath) > 0 Then
            ' Note that the following block is NOT redundant.
            If Right(InitialFolderPath, 1) = "\" Then
                FolderPath = InitialFolderPath
            Else
                FolderPath = InitialFolderPath & "\"
            End If
            .InitialFileName = FolderPath
        End If
        If .Show Then
            FolderPath = .SelectedItems(1)
            If Right(FolderPath, 1) <> "\" Then
                FolderPath = FolderPath & "\"
            End If
            PickFolder = FolderPath
        Else
            ' Optionally, out-comment or use a message box.
            Debug.Print "'PickFolder': dialog canceled."
        End If
    End With
End Function