Hej!
Har fått som sommarjobb att sammanställa data från ca 3000 exceldokument till ett enda arbetsblad, och vill helst inte göra det manuellt då det är ca 50 celler från varje arbetsbok som ska importeras.
Det jag har lyckats med hitills är följande:
Sub ImporteraExcelTillExcel_ADO()
'--------------------------------------------------------------
'importerar data från en extern Excelbok utan att öppna den
'--------------------------------------------------------------
'variabeldeklareringar
Dim datConnection As ADODB.Connection
Dim recSet As ADODB.Recordset
Dim strDB, strSQL As String
Dim strDriver As String
Dim i As Long
'sökväg till den externa Excelfilen
strDB = "C:\Momentstatistik\Diagram\11529697.xls"
'Uppkoppling
Set datConnection = New ADODB.Connection
Set recSetKplNr = New ADODB.Recordset
Set recSetSmNr = New ADODB.Recordset
Set recSetMpNr = New ADODB.Recordset
Set recSetKplTyp = New ADODB.Recordset
Set recSetP0 = New ADODB.Recordset
Set recSetTeoM = New ADODB.Recordset
Set recSetTest1 = New ADODB.Recordset
Set recSetTest2 = New ADODB.Recordset
Set recSetTest3 = New ADODB.Recordset
Set recSetTest4 = New ADODB.Recordset
Set recSetTest5 = New ADODB.Recordset
Set recSetDatum = New ADODB.Recordset
datConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & strDB & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
'SQL-förfrågan
strSQLKplNr = "SELECT * FROM [Momentprovning$D1:D1]"
strSQLSmNr = "SELECT * FROM [Momentprovning$D2:D2]"
strSQLMpNr = "SELECT * FROM [Momentprovning$D3:D4]"
strSQLKplTyp = "SELECT * FROM [Momentprovning$J1:K1]"
strSQLP0 = "SELECT * FROM [Momentprovning$O1:O1]"
strSQLTeoM = "SELECT * FROM [Momentprovning$O2:O3]"
strSQLTest1 = "SELECT * FROM [Momentprovning$D5:I6]"
strSQLTest2 = "SELECT * FROM [Momentprovning$D7:I8]"
strSQLTest3 = "SELECT * FROM [Momentprovning$D9:I10]"
strSQLTest4 = "SELECT * FROM [Momentprovning$D11:I12]"
strSQLTest5 = "SELECT * FROM [Momentprovning$D13:I14]"
strSQLDatum = "SELECT * FROM [Momentprovning$J2:K2]"
'Öppnar ett recordset
recSetKplNr.Open strSQLKplNr, datConnection, adOpenStatic
recSetSmNr.Open strSQLSmNr, datConnection, adOpenStatic
recSetMpNr.Open strSQLMpNr, datConnection, adOpenStatic
recSetKplTyp.Open strSQLKplTyp, datConnection, adOpenStatic
recSetP0.Open strSQLP0, datConnection, adOpenStatic
recSetTeoM.Open strSQLTeoM, datConnection, adOpenStatic
recSetTest1.Open strSQLTest1, datConnection, adOpenStatic
recSetTest2.Open strSQLTest2, datConnection, adOpenStatic
recSetTest3.Open strSQLTest3, datConnection, adOpenStatic
recSetTest4.Open strSQLTest4, datConnection, adOpenStatic
recSetTest5.Open strSQLTest5, datConnection, adOpenStatic
recSetDatum.Open strSQLDatum, datConnection, adOpenStatic
'Kopierar in data till workbooken
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetKplNr
ActiveSheet.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetSmNr
ActiveSheet.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetMpNr
ActiveSheet.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetKplTyp
ActiveSheet.Range("E" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetP0
ActiveSheet.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetTeoM
ActiveSheet.Range("H" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetTest1
ActiveSheet.Range("N" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetTest2
ActiveSheet.Range("T" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetTest3
ActiveSheet.Range("Z" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetTest4
ActiveSheet.Range("AF" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetTest5
ActiveSheet.Range("AL" & Rows.Count).End(xlUp).Offset(1, 0).CopyFromRecordset recSetDatum
'Kopplar ned
recSetKplNr.Close
recSetSmNr.Close
recSetMpNr.Close
recSetKplTyp.Close
recSetP0.Close
recSetTeoM.Close
recSetTest1.Close
recSetTest2.Close
recSetTest3.Close
recSetTest4.Close
recSetTest5.Close
recSetDatum.Close
datConnection.Close
'Stänger ned objekten
Set recSetKplNr = Nothing
Set recSetSmNr = Nothing
Set recSetMpNr = Nothing
Set recSetKplTyp = Nothing
Set recSetP0 = Nothing
Set recSetTeoM = Nothing
Set recSetTest1 = Nothing
Set recSetTest2 = Nothing
Set recSetTest3 = Nothing
Set recSetTest4 = Nothing
Set recSetTest5 = Nothing
Set recSetDatum = Nothing
Set datConnection = Nothing
End Sub
Detta ger mig de data jag vill ha, men bara från en arbetsbok, (11529697.xls). Men vill kunna få in för alla 3000.
Det jag tänker skulle kunna fungera är att försöka göra en lista på alla .xls dokument i en viss mapp, (Alla externa filer ligger i samma mapp, (T.ex: C:\Momentstatistik\Diagram) och sedan lägga in typ
For Each FILE In LISTA
[Gör ovanstående]
Exit For
Någon som vet hur man ska gå till väga för att lösa detta?
Tack på förhand
///Marcus