Private Arr() As Variant
Function RetrieveManningData()
Dim lShop As Long, xlsApp As Excel.Application
Dim xlsWorkbook As Excel.Workbook, xlsWorkSheet As Worksheet
Dim xlsSheet1 As Worksheet
Dim strProject As String, strTSD As String, iXLSPosition As Long
iXLSPosition = 1
Set xlsSheet1 = Excel.Worksheets("Manning")
Set xlsApp = New Excel.Application
ReDim Arr(1 To 100)
BrowseFile "Excel"
If bCanceled = True Then
Exit Function
End If
For x = LBound(Arr) To UBound(Arr)
'Setup process to retrieve the informaiton
debug.print CStr(Arr(x)) ' Returns File location and name
'Break from array if findshop returns 0
If lShop <> 0 Then
'Debug.Print lShop
Set xlsWorkbook = xlsApp.Workbooks.Open(CStr(Arr(x)))
Set xlsWorkSheet = xlsApp.Worksheets("qryRAPAssignment")
' Do data digging here
End If
xlsApp.Quit
Next x
Set xlsSheet1 = Nothing
Set xlsWorkSheet = Nothing
Set xlsApp = Nothing
End Function
Function BrowseFile(Optional strFilter As String) As Variant
Dim fdg As FileDialog, vrtSelectedItem As Variant
Dim V() As Variant
ReDim V(1 To 100)
Dim i As Long
Set fdg = Application.FileDialog(msoFileDialogFilePicker)
If strFilter <> "" Then
fdg.Filters.Clear
Select Case strFilter
Case "Pictures"
fdg.Filters.Add "Pictures", "*.jpg; *.gif; *.bmp"
Case "PDF"
fdg.Filters.Add "PDF", "*.pdf"
Case "Excel"
fdg.Filters.Add "Excel", "*.xls; *.xlsx"
Case "CSV"
fdg.Filters.Add "CSV", "*.csv"
End Select
End If
With fdg
.AllowMultiSelect = True
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
i = i + 1
V(i) = vrtSelectedItem
Next vrtSelectedItem
Arr = V
End If
If .SelectedItems.Count = 0 Then
bCanceled = True
Else
bCanceled = False
End If
End With
Set fdg = Nothing
End Function