Option Explicit Option Base 1 Sub Get_Singel_Values_Closed_Workbooks() Dim fsoObj As Scripting.FileSystemObject Dim fsoFolder As Scripting.Folder Dim fsoFile As Scripting.File Dim rst As ADODB.Recordset Dim stCon As String, stSQL As String Dim i As Long 'Instantiate new FSO-objects Set fsoObj = New Scripting.FileSystemObject 'folder name (not the file name): Set fsoFolder = fsoObj.GetFolder("C:\Documents and Settings\anjohnson\Desktop\Cashflow\TEST") 'Instantiate a new Recordset-object which also will be the only ADO-object 'we use in this sample Set rst = New ADODB.Recordset For Each fsoFile In fsoFolder.Files If fsoFile Like "*.xls" Then stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & fsoFolder & "\" & fsoFile.Name & ";" & _ "Extended Properties=""Excel 8.0;HDR=No;IMEX=1""" stSQL = "SELECT * From [Sheet1$]" 'Create/open the connection and execute the SQL-statement. rst.Open stSQL, stCon, adOpenForwardOnly, adLockReadOnly, adCmdText 'Transfer the copied recordset to the activesheet. With Application .ScreenUpdating = False With ActiveSheet .Range("A1").CopyFromRecordset rst ' numbers will be imported as text due to the IMEX setting ' so convert to numbers. With .UsedRange .Value = .Value End With End With .ScreenUpdating = True End With 'Empty the string-variables and close the connection. 'By only closing but not setting the rst-variable to nothing we 'actually use the connection pooling technique. stCon = Empty stSQL = Empty rst.Close End If Next fsoFile 'Release objects from memory. Set fsoFile = Nothing Set fsoFolder = Nothing Set rst = Nothing End Sub
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.