Loop Through Folder and Take Specific Actions Based on Filename

[reberryjr]

I've looked around the web a bit, but I'm struggling to find a solution that fits my needs. Essentially, I want to be able to push a button and have VBA tap out to a specific folder and loop through each excel file within that folder and take certain actions based on the filename. There could be different versions of a file (e.g., Apple1, Apple2, Apple7, etc.). If I'm reaching out for a particular file, I can code to that, but getting the code to read the filename so it knows what actions to take is throwing me off. Here's what I have so far:

Sub ImportDataFiles()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim m As Workbook
Dim mI As Worksheet, mV As Worksheet, mN As Worksheet, mO As Worksheet, mP As Worksheet
Dim mILR As Long, mVLR As Long, mNLR As Long, mOLR As Long, mPLR As Long
Dim fP As String, fF As String, fE As String

Set m = ThisWorkbook
Set mI = m.Sheets("CC_I")
Set mV = m.Sheets("CC_V")
Set mN = m.Sheets("CC_N")
Set mO = m.Sheets("OP")
Set mP = m.Sheets("P")

'Sets the Tool's input folder location.
fP = ("\\Network Shared Drive\") 'Actual path removed for security reasons.

'Declares the target files' extension as Excel.
fE = "*.xls*"

fF = Dir(fP & fE)

'Loop through the Tool's input folder and import data files.
Do While fF <> ""

    If fF = "Apple.xls*" Then
        mI.Range("A4") = "Red"
    Else
        If fF = "Banana.xls*" Then
            mI.Range("A7") = "Yellow"
        End If
    End If

Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[Jeffrey Mahoney]

So in the code above that we worked on, you wanted to find specific files based on the name. The ImportCCIQRData doesn't use the name found, it uses it's own (*Quality Report.xlsx)

The changes I made below will send the path & filename to the Import SUB for each one it finds. Call it from the ImportDataFiles SUB like this: ImportCCIQRData(FP & FF)

Sub ImportCCIQRData(PathFile As String)

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim m As Workbook, s As Workbook
Dim mI As Worksheet, sD As Worksheet
Dim mILR As Long, sDLR As Long

Set m = ThisWorkbook
Set mI = m.Sheets("CC_I")

'Removes filters from the working data if any exist.
If mI.AutoFilterMode Then mI.AutoFilterMode = False

'Unhides any columns and rows that may be hidden on the working data.
With mI.UsedRange
    .Columns.EntireColumn.Hidden = False
    .Rows.EntireRow.Hidden = False
End With

mILR = mI.Range("A" & Rows.Count).End(xlUp).Row

'*****This section allows the User to select individual files for upload.*****
'Prompts the User to select the desired file to import.
'ISelect = MsgBox("Navigate to, and open the most recent Quality report.", vbOKCancel + vbInformation)

'If ISelect = vbOK Then
'    With Application.FileDialog(3)
'        .AllowMultiSelect = False
'        If .Show Then
'            fullpath = .SelectedItems.Item(1)
'            Set s = Workbooks.Open(fullpath)
'        End If
'
'        If s Is Nothing Then Exit Sub
'
'        Set sD = s.Sheets("Risk Responses")
'
'        sDLR = sD.Range("A" & Rows.Count).End(xlUp).Row
'    End With
'Else:  Exit Sub
'End If

'Opens and sets the source file.
Set s = Workbooks.Open(PathFile)
Set sD = s.Sheets("Risk Responses")
sDLR = sD.Range("A" & Rows.Count).End(xlUp).Row

sD.Activate

'Deletes the first 3 rows as they don't contain pertinent data.
sD.Range("A1:A3").EntireRow.Delete

'Removes filters from the source data if any exist.
If sD.AutoFilterMode Then sD.AutoFilterMode = False

'Unhides any columns and rows that may be hidden on the source data.
With sD.UsedRange
    .Columns.EntireColumn.Hidden = False
    .Rows.EntireRow.Hidden = False
End With

'Copies the data from the source file and pastes it onto this worksheet.
sD.Range("A2:P" & sDLR).Copy
    mI.Range("A" & mILR + 1).PasteSpecial xlPasteValues

'Closed the source file without saving it.
s.Close SaveChanges:=False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[reberryjr]

So in the code above that we worked on, you wanted to find specific files based on the name. The ImportCCIQRData doesn't use the name found, it uses it's own (*Quality Report.xlsx)

The changes I made below will send the path & filename to the Import SUB for each one it finds. Call it from the ImportDataFiles SUB like this: ImportCCIQRData(FP & FF)

Sub ImportCCIQRData(PathFile As String)

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim m As Workbook, s As Workbook
Dim mI As Worksheet, sD As Worksheet
Dim mILR As Long, sDLR As Long

Set m = ThisWorkbook
Set mI = m.Sheets("CC_I")

'Removes filters from the working data if any exist.
If mI.AutoFilterMode Then mI.AutoFilterMode = False

'Unhides any columns and rows that may be hidden on the working data.
With mI.UsedRange
    .Columns.EntireColumn.Hidden = False
    .Rows.EntireRow.Hidden = False
End With

mILR = mI.Range("A" & Rows.Count).End(xlUp).Row

'*****This section allows the User to select individual files for upload.*****
'Prompts the User to select the desired file to import.
'ISelect = MsgBox("Navigate to, and open the most recent Quality report.", vbOKCancel + vbInformation)

'If ISelect = vbOK Then
'    With Application.FileDialog(3)
'        .AllowMultiSelect = False
'        If .Show Then
'            fullpath = .SelectedItems.Item(1)
'            Set s = Workbooks.Open(fullpath)
'        End If
'
'        If s Is Nothing Then Exit Sub
'
'        Set sD = s.Sheets("Risk Responses")
'
'        sDLR = sD.Range("A" & Rows.Count).End(xlUp).Row
'    End With
'Else:  Exit Sub
'End If

'Opens and sets the source file.
Set s = Workbooks.Open(PathFile)
Set sD = s.Sheets("Risk Responses")
sDLR = sD.Range("A" & Rows.Count).End(xlUp).Row

sD.Activate

'Deletes the first 3 rows as they don't contain pertinent data.
sD.Range("A1:A3").EntireRow.Delete

'Removes filters from the source data if any exist.
If sD.AutoFilterMode Then sD.AutoFilterMode = False

'Unhides any columns and rows that may be hidden on the source data.
With sD.UsedRange
    .Columns.EntireColumn.Hidden = False
    .Rows.EntireRow.Hidden = False
End With

'Copies the data from the source file and pastes it onto this worksheet.
sD.Range("A2:P" & sDLR).Copy
    mI.Range("A" & mILR + 1).PasteSpecial xlPasteValues

'Closed the source file without saving it.
s.Close SaveChanges:=False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

@Jeffrey Mahoney I haven't forgotten about this. I had to implement a workaround, but once I get past another part of this project, I'll circle back to this as I want to understand how it should work. I appreciate all of your feedback!