getting data from a collection of workbooks into 1 single master file

[Schzuki]

Hi,

I'm trying to collect specific data from a collection of different (.xls) files into 1 master file using the following code (which runs in the master file):

Sub FolderPick()
[B][COLOR=#800080]Set fso = CreateObject("Scripting.FileSystemObject")

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path  ' Give the path
        .Title = "Please select a folder to list Files from"
        If .Show = True Then
        Else
            Exit Sub
        End If
    End With

[U] FldPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)[/U]
 Set folder = fso.GetFolder(FldPath)

For Each file In folder.Files
    c = c + 1
Name = file.Name[/COLOR][/B]

Workbooks.Open Filename:=[B][COLOR=#ff0000]"Path\****************" & Name & "*************" & ".xls"""[/COLOR][/B]
Mixture = Workbooks(Name).Worksheets("general").Cells("a4").Value
current = ThisWorkbook.Worksheets("stuff")

'lookup value in list, set row nr
Row = Application.WorksheetFunction.Match(Mixture, Range("B3:B60"), 0)

'goto report file, tab results

'find scenario and copy data
kolom = 2
lijst = Workbooks(Name).Worksheets("Results").Range("B3: B10")

For Each Scenario In lijst
kolom = kolom + 6
Scenario = Worksheets(current).Range(kolom & 1).Value

ThisWorkbook.Worksheets(current).Range("B" & Row).Value = Application.WorksheetFunction.VLookup(Scenario, Workbooks(Name).Worksheets("Results").Range("B3: AC10"), 3, False)
ThisWorkbook.Worksheets(current).Range("C" & Row).Value = Application.WorksheetFunction.VLookup(Scenario, Workbooks(Name).Worksheets("Results").Range("B3: AC10"), 7, False)
ThisWorkbook.Worksheets(current).Range("D" & Row).Value = Application.WorksheetFunction.VLookup(Scenario, Workbooks(Name).Worksheets("Results").Range("B3: AC10"), 11, False)

ThisWorkbook.Worksheets(current).Range("E" & Row).Value = Application.WorksheetFunction.VLookup(Scenario, Workbooks(Name).Worksheets("Results").Range("B3: AC10"), 21, False)
ThisWorkbook.Worksheets(current).Range("F" & Row).Value = Application.WorksheetFunction.VLookup(Scenario, Workbooks(Name).Worksheets("Results").Range("B3: AC10"), 25, False)
ThisWorkbook.Worksheets(current).Range("G" & Row).Value = Application.WorksheetFunction.VLookup(Scenario, Workbooks(Name).Worksheets("Results").Range("B3: AC10"), 29, False)
Next Scenario

Workbooks(Name).Close False
Next file

MsgBox "There were " & c & " file(s) found."

Set file = Nothing
Set folder = Nothing
Set fso = Nothing

End Sub

I'm having trouble with the Name-variable in the 'red line'. This variable is set in the 'purple lines' however, the code (which I got online) keeps adding ".pdf" to the name.

I think it has to do with the settings of the 'purple/underlined line' but I don't know if this is true and if so, how to change it. Can you help me?

thanks in advance!

Schzuki

 

[daverunt]

Hi,

I am in a bit of a hurry so I hope this works ok.

The first file it is coming across in the selected folder must be a .pdf file?
You need to filter out the .xls files in the selected folder for opening.
So we take each filename, extract the extension and compare it to ".xls" if it is correct we open the file otherwise we move onto the next.

FoldPath is the Path
Name is the filename including the extension.

For Each file In folder.Files
    c = c + 1
Name = file.Name

Ext = Right(Name, 4)  'gets the extension including dot. If you didn't include the dot the InStr check would also open .xlsm, .xlsx files found
If InStr(Ext, ".xls") Then


Workbooks.Open Filename:=FldPath & "\" & Name

....rest of code


Workbooks(Name).Close False
End If
Next file

 

[Schzuki]

that's not really the problem. But while I was going over things I found a mistake in the way I selected my path. (which solved my problem)
sorry for wasting your time, my bad!

Thanks for the reaction nonetheless!