Public fPath As String
Private Sub CheckBox1_Click()
Dim lItem As Long
If CheckBox1.Value = True Then
For lItem = 0 To Me.ListBox1.ListCount - 1
ListBox1.Selected(lItem) = True
Next
Else
For lItem = 0 To Me.ListBox1.ListCount - 1
ListBox1.Selected(lItem) = False
Next
End If
End Sub
Sub SelectAll()
Dim lItem As Long
For lItem = 0 To Me.ListBox1.ListCount - 1
ListBox1.Selected(lItem) = True
Next
End Sub
Private Sub CommandButton1_Click()
ListBox1.Clear
fPath = BrowseForFolder & "\"
Fill_List
End Sub
Sub Fill_List()
Dim fileList() As String
Dim fName As String
Dim I As Integer
fName = Dir(fPath)
While fName <> ""
I = I + 1
ReDim Preserve fileList(1 To I)
fileList(I) = fName
fName = Dir()
Wend
If I = 0 Then
MsgBox "No files found"
Exit Sub
End If
For I = 1 To UBound(fileList)
If fileList(I) Like "*.xl*" Then
Me.ListBox1.AddItem fileList(I)
End If
Next
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
Private Sub CommandButton2_Click()
Dim lItem As Long
Dim cn As Object
Dim strSQL As String
Set cn = CreateObject("ADODB.Connection")
For lItem = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(lItem) Then
strSQL = strSQL & IIf(Len(strSQL) = 0, "select ", " union all select") & " '" & Me.ListBox1.List(lItem) & "' as Ten,F2,F3,F6 from [EXCEL 12.0;HDR=No;Database=" & fPath & Me.ListBox1.List(lItem) & "].[Sheet1$A2:J] where F1 is not null"
ListBox1.Selected(lItem) = False
End If
Next
strSQL = "select F2,F3,count(F3),sum(F6) from (" & strSQL & ") group by F2,F3"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"""
Sheet1.Range("A2").CopyFromRecordset cn.Execute(strSQL)
End Sub
