Gegevens importeren uit een gesloten werkmap (ADO) met VBA in Microsoft Excel

Anonim

Als u veel gegevens uit een gesloten werkmap wilt importeren, kunt u dit doen met ADO en onderstaande macro.
Als u gegevens wilt ophalen uit een ander werkblad dan het eerste werkblad in de gesloten werkmap,
u moet verwijzen naar een door de gebruiker gedefinieerd benoemd bereik. Onderstaande macro kan als volgt worden gebruikt (in Excel 2000 of later):

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) ' vereist een verwijzing naar de Microsoft ActiveX Data Objects-bibliotheek ' als SourceRange een bereikverwijzing is: ' dit retourneert gegevens uit het eerste werkblad in SourceFile ' als SourceRange een gedefinieerde naamreferentie: ' dit retourneert gegevens van elk werkblad in SourceFile ' SourceRange moet de bereikheaders bevatten ' Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset Dim dbConnectionString As String Dim TargetCell As Range, i As Integer dbConnectionString = "DRIVER ={Microsoft Excel-stuurprogramma (*.xls)};" & _ "ReadOnly=1;DBQ=" & SourceFile Set dbConnection = Nieuwe ADODB.Connection On Error GoTo InvalidInput dbConnection.Open dbConnectionString ' open de databaseverbinding Set rs = dbConnection.Execute("[" & SourceRange & "]") Set 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 Volgende i Set TargetCell = TargetCell .Offset(1, 0) End If TargetCell.CopyFromRecordset rs rs.Close dbConnection.Close ' sluit de databaseverbinding Set TargetCell = Niets Set rs = Niets Set dbConnection = Niets op fout GoTo 0 Exit Sub InvalidInput: MsgBox "Het bronbestand of bronbereik is ongeldig!", _ vbExclamation, "Gegevens ophalen uit gesloten werkmap" End Sub

Een andere methode die geen gebruik maakt van de CopyFromRecordSet-methode Met onderstaande macro kun je de import uitvoeren en heb je betere controle over de resultaten die door de RecordSet worden geretourneerd.

Sub TestReadDataFromWorkbook() ' vult gegevens van een gesloten werkmap in bij de actieve cel Dim tArray As Variant, r As Long, c As Long tArray = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:B21") ' zonder te transponeren ' 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) ' Next c ' Next r ' met transponeren 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) Next c Next r End Sub Private Function ReadDataFromWorkbook (SourceFile As String, SourceRange As String) As Variant ' vereist een verwijzing naar de Microsoft ActiveX Data Objects-bibliotheek ' als SourceRange een bereikverwijzing is: ' deze functie kan alleen gegevens van het eerste werkblad in SourceFile retourneren ' als SourceRange een gedefinieerde naamverwijzing is: ' deze functie kan gegevens van m elk werkblad in SourceFile ' SourceRange moet de bereikheaders bevatten ' voorbeelden: ' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:A21") ' varRecordSetData = ReadDataFromWorkbook("C:\FolderName.SourceWb 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 de databaseverbinding Set rs = dbConnection.Execute("[" & SourceRange & "]") On Error GoTo 0 ReadDataFromWorkbook = rs.GetRows ' retourneert een tweekleurige array met alle records in rs rs.Close dbConnection.Close ' sluit de databaseverbinding Set rs = Nothing Set dbConnection = Nothing On Error GoTo 0 Afsluitfunctie InvalidInput: MsgBox "Het bronbestand of bronbereik is ongeldig!", vbExclamation, "Gegevens ophalen uit gesloten werkmap" Set rs = Niets Set dbConnection = Niets Eindfunctie

Het macrovoorbeeld gaat ervan uit dat uw VBA-project een verwijzing naar de ADO-objectbibliotheek heeft toegevoegd.
U kunt dit doen vanuit de VBE door het menu Tools, References te selecteren en Microsoft . te selecteren
ActiveX-gegevensobjecten x.x-objectbibliotheek.
Gebruik ADO als u kunt kiezen tussen ADO en DAO voor het importeren of exporteren van gegevens.