Εισαγάγετε δεδομένα από ένα κλειστό βιβλίο εργασίας (ADO) χρησιμοποιώντας VBA στο Microsoft Excel

Anonim

Εάν θέλετε να εισαγάγετε πολλά δεδομένα από ένα κλειστό βιβλίο εργασίας, μπορείτε να το κάνετε με το ADO και τη μακροεντολή παρακάτω.
Εάν θέλετε να ανακτήσετε δεδομένα από άλλο φύλλο εργασίας από το πρώτο φύλλο εργασίας στο κλειστό βιβλίο εργασίας,
πρέπει να ανατρέξετε σε ένα καθορισμένο από το χρήστη όνομα περιοχής. Η παρακάτω μακροεντολή μπορεί να χρησιμοποιηθεί ως εξής (στο Excel 2000 ή νεότερη έκδοση):

GetDataFromClosedWorkbook "C: \ FolderName \ WorkbookName.xls", "A1: B21", ActiveCell, False GetDataFromClosedWorkbook "C: \ FolderName \ WorkbookName.xls", "MyDataRange", Range ("B3") True True GetDataFrom (Source String, SourceRange As String, _ TargetRange As Range, IncludeFieldNames As Boolean) "απαιτεί αναφορά στη βιβλιοθήκη Microsoft Objects Data Objects" εάν το SourceRange είναι μια αναφορά εύρους: "αυτό θα επιστρέψει δεδομένα από το πρώτο φύλλο εργασίας στο SourceFile" εάν το SourceRange είναι καθορισμένη αναφορά ονόματος: "αυτό θα επιστρέψει δεδομένα από οποιοδήποτε φύλλο εργασίας στο SourceFile" Το SourceRange πρέπει να περιλαμβάνει τις επικεφαλίδες εύρους "Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset Dim dbConnectionString As String Dim TargetCell As Range, i As Integer dbConnectionString =" DRIVER = {Πρόγραμμα οδήγησης Microsoft Excel (*.xls)}; " & _ "ReadOnly = 1; DBQ =" & SourceFile Set dbConnection = New ADODB.Connection On Error GoTo InvalidInput dbConnection.Open dbConnectionString "άνοιγμα της σύνδεσης βάσης δεδομένων Set rs = dbConnection.Execute (" ["& SourceRange &"] 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) Τέλος Αν TargetCell.CopyFromRecordset rs rs.Close dbConnection.Close 'κλείστε τη σύνδεση βάσης δεδομένων Ορίστε TargetCell = Τίποτα Ρύθμιση rs = Τίποτα Σετ dbConnection = Τίποτα Σφάλμα GoTo 0 Exit Sub InvalidInput: MsgBox "Το αρχείο προέλευσης ή το εύρος πηγής δεν είναι έγκυρο! ", _ vbExclamation," Λήψη δεδομένων από κλειστό βιβλίο εργασίας "Τέλος υπο

Μια άλλη μέθοδος που δεν χρησιμοποιεί τη μέθοδο CopyFromRecordSet Με την παρακάτω μακροεντολή μπορείτε να εκτελέσετε την εισαγωγή και να έχετε καλύτερο έλεγχο των αποτελεσμάτων που επιστρέφονται από το RecordSet.

Sub TestReadDataFromWorkbook () 'συμπληρώνει δεδομένα από ένα κλειστό βιβλίο εργασίας στο ενεργό κελί Dim tArray As Variant, r As Long, c As Long tArray = ReadDataFromWorkbook ("C: \ FolderName \ SourceWbName.xls", "A1: B21")' χωρίς μεταφορά "Για r = LBound (tArray, 2) Προς UBound (tArray, 2)" Για c = LBound (tArray, 1) Σε UBound (tArray, 1) "ActiveCell. Offset (r, c). Formula = tArray ( c, r) 'Next c' Next r 'with transposing 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 r Priv Private Function ReadDataFromWorkbook (SourceFile As String, SourceRange As String) As Variant »απαιτεί αναφορά στη βιβλιοθήκη του Microsoft ActiveX Data Objects "εάν το SourceRange είναι μια αναφορά εύρους:" αυτή η λειτουργία μπορεί να επιστρέψει δεδομένα μόνο από το πρώτο φύλλο εργασίας στο SourceFile "εάν το SourceRange είναι μια καθορισμένη αναφορά ονόματος:" αυτή η λειτουργία μπορεί να επιστρέψει δεδομένα από πίσω m οποιοδήποτε φύλλο εργασίας στο SourceFile 'Το SourceRange πρέπει να περιλαμβάνει παραδείγματα κεφαλίδων εύρους:' varRecordSetData = ReadDataFromWorkbook ("C: \ FolderName \ SourceWbName.xls", "A1: A21") 'varRecordSetData = ReadDataFromWorkbook ("C: \ FolderName xls "," A1: B21 ") 'varRecordSetData = ReadDataFromWorkbook (" C: \ FolderName \ SourceWbName.xls "," DefinedRangeName ") Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset Dim dbConnectionString = {Microsoft Excel Driver (*.xls)}; ReadOnly = 1; DBQ = "& SourceFile Set dbConnection = New ADODB.Connection On Error GoTo InvalidInput dbConnection.Open dbConnectionString" ανοίξτε τη σύνδεση βάσης δεδομένων Ορίστε rs = dbConnection.Execute (" & SourceRange & "]") On Error GoTo 0 ReadDataFromWorkbook = rs.GetRows 'επιστρέφει έναν πίνακα δύο αμυδρά με όλες τις εγγραφές στο rs rs.Close' dbConnection.Close 'κλείστε τη σύνδεση βάσης δεδομένων Ρύθμιση rs = Τίποτα δεν dbConnection = Τίποτα σε σφάλμα GoTo 0 Λειτουργία εξόδου InvalidInput: MsgBox "Το αρχείο προέλευσης ή το εύρος πηγής δεν είναι έγκυρο! ", vbExclamation," Λήψη δεδομένων από κλειστό βιβλίο εργασίας "Ορισμός rs = Τίποτα ρύθμιση dbConnection = Τίποτα Τερματισμός λειτουργίας

Το παράδειγμα μακροεντολής υποθέτει ότι το έργο VBA σας έχει προσθέσει μια αναφορά στη βιβλιοθήκη αντικειμένων ADO.
Μπορείτε να το κάνετε αυτό μέσα από το VBE επιλέγοντας το μενού Εργαλεία, Αναφορές και επιλέγοντας τη Microsoft
Βιβλιοθήκη αντικειμένων ActiveX Data Objects x.x.
Χρησιμοποιήστε το ADO εάν μπορείτε να επιλέξετε μεταξύ ADO και DAO για εισαγωγή ή εξαγωγή δεδομένων.