Hvis du vil importere mye data fra en lukket arbeidsbok, kan du gjøre dette med ADO og makroen nedenfor.
Hvis du vil hente data fra et annet regneark enn det første regnearket i den lukkede arbeidsboken,
du må referere til et brukerdefinert navngitt område. Makroen nedenfor kan brukes slik (i Excel 2000 eller nyere):
GetDataFromClosedWorkbook "C: \ FolderName \ WorkbookName.xls", "A1: B21", ActiveCell, False GetDataFromClosedWorkbook "C: \ FolderName \ WorkbookName.xls", "MyDataRange", Range ("B3"), True Sub GetDataFromClosedWorkbook (SourceFile As) String, SourceRange As String, _ TargetRange As Range, IncludeFieldNames As Boolean) 'krever en referanse til Microsoft ActiveX Data Objects -biblioteket' hvis SourceRange er en områdereferanse: 'dette vil returnere data fra det første regnearket i SourceFile' hvis SourceRange er en definert navnreferanse: 'dette vil returnere data fra et hvilket som helst regneark i SourceFile' SourceRange må inkludere områdehodene '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 'åpne databasetilkoblingen Sett rs = dbConnection.Execute ("[" & SourceRange & "]") Sett TargetCell = TargetRange.Cells (1, 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 'close the database connection Set TargetCell = Nothing Set rs = Nothing Set dbConnection = Nothing On Error GoTo 0 Exit Sub InvalidInput: MsgBox "Kildefilen eller kildeområdet er ugyldig! ", _ vbExclamation," Get data from closed workbook "End Sub
En annen metode som ikke bruker CopyFromRecordSet-metoden Med makroen nedenfor kan du utføre importen og ha bedre kontroll over resultatene som er returnert fra RecordSet.
Sub TestReadDataFromWorkbook () 'fyller ut data fra en lukket arbeidsbok i den aktive cellen Dim tArray As Variant, r As Long, c As Long tArray = ReadDataFromWorkbook ("C: \ FolderName \ SourceWbName.xls", "A1: B21")' uten å transponere 'For r = LBound (tArray, 2) To UBound (tArray, 2)' For c = LBound (tArray, 1) To UBound (tArray, 1) 'ActiveCell.Offset (r, c). Formula = tArray ( c, r) 'Neste c' Neste r 'med transponering av tArray = Application.WorksheetFunction.Transpose (tArray) For r = LBound (tArray, 1) To UBound (tArray, 1) For c = LBound (tArray, 2) To UBound (tArray, 2) ActiveCell.Offset (r - 1, c - 1) .Formula = tArray (r, c) Neste c Neste r Avslutt Sub Private Function ReadDataFromWorkbook (SourceFile As String, SourceRange As String) As Variant 'krever en referanse til Microsoft ActiveX Data Objects -biblioteket 'hvis SourceRange er en områdereferanse:' denne funksjonen kan bare returnere data fra det første regnearket i SourceFile 'hvis SourceRange er en definert navnereferanse:' denne funksjonen kan returnere data fra m et hvilket som helst regneark i SourceFile 'SourceRange må inneholde rekkeviddeoverskriftens eksempler:' varRecordSetData = ReadDataFromWorkbook ("C: \ FolderName \ SourceWbName.xls", "A1: A21") 'varRecordSetData = ReadDataFromWorkbook ("C: \ FolderName \ SourceWbName. xls "," A1: B21 ") 'varRecordSetData = ReadDataFromWorkbook (" C: \ FolderName \ SourceWbName.xls "," DefinedRangeName ") Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset Dim dbConnectionString As String dbConnection {Microsoft Excel Driver (*.xls)}; ReadOnly = 1; DBQ = "& SourceFile Set dbConnection = New ADODB.Connection On Error GoTo InvalidInput dbConnection.Open dbConnectionString 'open the database connection Set rs = dbConnection.Execute (" [" & SourceRange & "]") Ved feil GoTo 0 ReadDataFromWorkbook = rs.GetRows returnerer en to -dim matrise med alle poster i rs rs.Lukk dbConnection.Close 'lukk databasetilkoblingen Sett rs = Nothing Set dbConnection = Nothing On Error GoTo 0 Avslutt funksjon InvalidInput: MsgBox "Kildefilen eller kildeområdet er ugyldig! ", vbExclamation," Hent data fra lukket arbeidsbok "Sett rs = Nothing Set dbConnection = Nothing End Function
Makroeksemplet forutsetter at VBA -prosjektet ditt har lagt til en referanse til ADO -objektbiblioteket.
Du kan gjøre dette fra VBE ved å velge menyen Verktøy, Referanser og velge Microsoft
ActiveX Data Objects x.x Object Library.
Bruk ADO hvis du kan velge mellom ADO og DAO for dataimport eller eksport.