import all sheets from a closed workbook

[johnpetrusa]

Hi,

I need to import all sheets from a some closed workbooks to my activ
workbook

some like:

row1: workbookname - worksheet_name1
row2-xxx: --all content of worksheet(1)--

rowXX: workbookname - worksheet_name2
rowXX: --all content of worksheet(2)--

All in the same worksheet, one below the other.

I´m using a sub:

Sub GetDataFromClosedWorkbook(SourceFile As String, SourceRange A
String, _
TargetRange As Range, IncludeFieldNames As Boolean)
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
Dim TargetCell As Range, i As Integer
dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};"
"ReadOnly=1;DBQ=" & SourceFile
Set dbConnection = New ADODB.Connection
On Error GoTo InvalidInput
dbConnection.Open dbConnectionString
Set rs = dbConnection.Execute("[" & SourceRange & "]")
Set TargetCell = TargetRange.Cells(2, 1)
If IncludeFieldNames Then
For i = 0 To rs.Fields.Count - 1
TargetCell.Offset(0, i).Formula = rs.Fields(i).Name
Next i
Set TargetCell = TargetCell.Offset(1, 0)
End If
TargetCell.CopyFromRecordset rs
rs.Close
dbConnection.Close
Set TargetCell = Nothing
Set rs = Nothing
Set dbConnection = Nothing
On Error GoTo 0
Exit Sub

InvalidInput:
MsgBox "Error opening file." & vbCrLf & SourceFile & " not found!"
vbExclamation, "Import"

End Sub

But .. this only form for workSheet(1)

some idea?

Tnx

 

[michelxld]

Hello

you may try


Sub importDatas_FromAllSheets_ClosedWorkbook()
'Activate Microsoft ActiveX Data Objects x.x Library
'Activate Microsoft ADO Ext 2.7 for DLL ans Security
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim Cat As ADOX.Catalog
Dim xConnect As String, Fichier As String, Cible As String
Dim Feuille As ADOX.Table
Dim i As Integer
Dim j As Byte

Fichier = "C:\closedWorkbook.xls"
i = 1
xConnect = "DRIVER={Microsoft Excel Driver (*.xls)};" & _
"ReadOnly=1;DBQ=" & Fichier

Set Cat = CreateObject("ADOX.Catalog")
Set Cn = CreateObject("ADODB.Connection")

Cn.Open xConnect
Set Cat.ActiveConnection = Cn

For Each Feuille In Cat.tables
Cells(i, 1) = Fichier
Cells(i, 2) = Feuille.Name

i = i + 1
For j = 1 To Feuille.Columns.Count
Cells(i, j) = Feuille.Columns(j - 1).Name
Next j

Cible = "SELECT * FROM [" & Feuille.Name & "];"

Set Rs = New ADODB.Recordset
Rs.Open Cible, xConnect, adOpenStatic, adLockOptimistic, adCmdText
i = i + 1
Cells(i, 1).CopyFromRecordset Rs
i = i + Rs.RecordCount + 1
Next

Cn.Close
Rs.Close
Set Cn = Nothing
Set Rs = Nothing

End Sub



Regards ,
miche

 

[johnpetrusa]

Thanks!, it work perfect!