Microsoft Excel'de VBA kullanarak kapalı bir çalışma kitabından (ADO) verileri içe aktarma

Anonim

Kapalı bir çalışma kitabından çok fazla veri almak istiyorsanız, bunu ADO ve aşağıdaki makro ile yapabilirsiniz.
Kapalı çalışma kitabındaki ilk çalışma sayfasından başka bir çalışma sayfasından veri almak istiyorsanız,
kullanıcı tanımlı bir adlandırılmış aralığa başvurmanız gerekir. Aşağıdaki makro şu şekilde kullanılabilir (Excel 2000 veya sonraki sürümlerde):

GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "A1:B21", ActiveCell, False GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "MyDataRange", Range ("B3"), True Sub GetDataFiFrom(SourceWorkbook) String, SourceRange As String, _ TargetRange As Range, IncludeFieldNames As Boolean) ' Microsoft ActiveX Data Objects kitaplığına bir referans gerektirir ' SourceRange bir aralık referansıysa: ' SourceRange bir tanımlı ad başvurusu: ' bu, SourceFile'daki herhangi bir çalışma sayfasından veri döndürür ' SourceRange, ' Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset Dim dbConnectionString As String Dim TargetCell As Range, i As Integer dbConnectionString = "DRI ={Microsoft Excel Sürücüsü (*.xls)};" & _ "ReadOnly=1;DBQ=" & SourceFile Set dbConnection = Yeni ADODB.Connection On Error GoTo InvalidInput dbConnection.Open dbConnectionString ' veritabanı bağlantısını açın Set rs = dbConnection.Execute("[" & SourceRange & "]") Set TargetCell = TargetRange.Cells(1, 1) If IncludeFieldNames O zaman i = 0 için rs.Fields.Count - 1 TargetCell.Offset(0, i).Formula = rs.Fields(i).Name Sonraki i HedefHücre Ayarla = TargetCell .Offset(1, 0) End If TargetCell.CopyFromRecordset rs rs.Close dbConnection.Close ' veritabanı bağlantısını kapatın Set TargetCell = Nothing Set rs = Nothing Set dbConnection = Nothing On Error GoTo 0 Exit Sub InvalidInput: MsgBox "Kaynak dosya veya kaynak aralığı geçersiz!", _ vbExclamation, "Kapalı çalışma kitabından veri al" End Sub

CopyFromRecordSet yöntemini kullanmayan başka bir yöntem Aşağıdaki makro ile içe aktarma işlemini gerçekleştirebilir ve RecordSet'ten döndürülen sonuçlar üzerinde daha iyi kontrol sahibi olabilirsiniz.

Sub TestReadDataFromWorkbook() ' kapalı bir çalışma kitabından verileri etkin hücrede doldurur Dim tArray As Variant, r As Long, c As Long tArray = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:B21") ' transpoze etmeden ' 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) ' Sonraki c ' Sonraki r ' devrik 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) Sonraki c Sonraki r End Sub Private Function ReadDataFromWorkbook(SourceFile As String, SourceRange As String) As Variant ' bir başvuru gerektirir Microsoft ActiveX Data Objects kitaplığına ' eğer SourceRange bir aralık referansıysa: ' bu fonksiyon SourceRange tanımlı bir isim referansıysa, sadece SourceFile'daki ilk çalışma sayfasından veri döndürebilir: ' bu fonksiyon şuradan veri döndürebilir SourceFile'daki herhangi bir çalışma sayfası SourceRange, aralık başlıklarını içermelidir ' örnekleri: ' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:A21") ' varRecordSetData = ReadDataFromWorkbook("C:\FolderWbName" xls", "A1:B21") ' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "DefinedRangeName") Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset Dim dbConnectionString As "Dize {Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & SourceFile Set dbConnection = New ADODB.Connection On Error GoTo InvalidInput dbConnection.Open dbConnectionString ' veritabanı bağlantısını açın Set rs = dbConnection.Execute("[" & SourceRange & "]") Hatada Git 0 ReadDataFromWorkbook = rs.GetRows ', tüm kayıtları rs rs.Close dbConnection.Close'da içeren iki loş bir dizi döndürür. Exit Function InvalidInput: MsgBox "Kaynak dosya veya kaynak aralığı geçersiz!", vbExclamation, "Kapalı çalışma kitabından veri al" Set rs = Nothing Set dbConnection = Nothing End Function

Makro örneği, VBA projenizin ADO nesne kitaplığına bir başvuru eklediğini varsayar.
Bunu, Araçlar, Referanslar menüsünü seçip Microsoft'u seçerek VBE içinden yapabilirsiniz.
ActiveX Veri Nesneleri x.x Nesne Kitaplığı.
Veri içe veya dışa aktarma için ADO ve DAO arasında seçim yapabiliyorsanız ADO'yu kullanın.