Use a selected filename in order to create IF statements.

[Boblhed]

Hi everyone,

I got this data mining code from here: Opening and Extracting Data From All Files in Root and Subfolders

The way the code works now is if you enter the filenames you want to mine data from, it will find them for you and list them next to the filename. My problem is, I want to be able to do this for several different folders, with different data in the same column. For example, in one folder, the data I might want may be in B2, B3 and B4. In another it might be B6, B7, B8, B9 and B10. Thankfully I have a limited number of folders for which I want to do this, and know their names. I intend to tell the program which row to get the data from by creating if statements for each folder, and then having the data acquisition done inside those if statements. The only thing is, I am new to excel and copying this code - I am unsure as to how I do this without breaking it.

Here is the code below:

Sub CollectDataBits()
'these dims are for collecting the subfolders
Dim objFSO As FileSystemObject
Dim objFld As Folder
Dim objSubFld As Folder
Dim objFile As File
Dim ListPaths
Dim fldCountNow As Long
Dim fldCountLast As Long
Dim i As Long

'these dims are for the section opening files and grabbing contents
Dim r As Long
Dim c As Long
Dim clarray
Dim fname As String
Dim datasht As Worksheet
Dim destsht As Worksheet
Application.ScreenUpdating = False
'get the folder user wants to start with
ReDim ListPaths(1 To 1)
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show Then ListPaths(1) = .SelectedItems(1) & "" Else Exit Sub
End With

'loop process for loading array with subfolders of user selected folder

fldCountLast = 1
Do While UBound(ListPaths) <> fldCountNow
fldCountNow = UBound(ListPaths)
For i = fldCountLast To fldCountNow
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFld = objFSO.GetFolder(ListPaths(i))
For Each objSubFld In objFld.SubFolders
ReDim Preserve ListPaths(1 To UBound(ListPaths) + 1)
ListPaths(UBound(ListPaths)) = objSubFld.Path
Next objSubFld
Set objFSO = Nothing
Set objFld = Nothing
Next i
fldCountLast = fldCountNow + 1
Loop

'open & collect contents of first file found in identified folders
'which matches the file name listed in Column A

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set destsht = ActiveSheet
clarray = Array("B8", "B9", "B10", "B12")
r = Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To r
Set datasht = Nothing
For i = LBound(ListPaths) To UBound(ListPaths)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFld = objFSO.GetFolder(ListPaths(i))
For Each objFile In objFld.Files
fname = objFile.Name
On Error Resume Next
fname = Left(fname, InStrRev(fname, ".") - 1)
On Error GoTo 0
If fname = Cells(r, 1) Then
Set datasht = Workbooks.Open(objFile.Path, , True).Sheets(1)
For c = LBound(clarray) To UBound(clarray)
destsht.Cells(r, c + 3) = datasht.Range(clarray(c))
Next c
datasht.Parent.Close
End If
Next objFile
If Not datasht Is Nothing Then Exit For
Set objFSO = Nothing
Set objFld = Nothing
Next i
Next r

End Sub


The modification I have made is near line 49 and 50.

If objFld = "ARMS" Then
clarray = Array("B12", "B13")
Set objFSO = Nothing
Set objFld = Nothing
End If

I intended to add else if statements for other folders once I had isolated the error and resolved it. I was wondering if anyone would be able to understand where this code will store the filename or how I could have it determine what it is in order to use it for an if statement?

Thank you for your help!