Sommario
Con le procedure seguenti è possibile utilizzare DAO per recuperare un recordset da una cartella di lavoro chiusa e leggere/scrivere dati.
Chiama la procedura in questo modo:
GetWorksheetData "C:\Foldername\Filename.xls", "SELECT * FROM [SheetName$]", ThisWorkbook.Worksheets(1).Range("A3")
Sostituisci SheetName con il nome del foglio di lavoro da cui vuoi recuperare i dati.
Sub GetWorksheetData(strSourceFile As String, strSQL As String, TargetCell As Range) Dim db As DAO.Database, rs As DAO.Recordset, f As Integer, r As Long Se TargetCell non è nulla Quindi esci da Sub On Error Riprendi il prossimo set db = OpenDatabase (strSourceFile, False, True, "Excel 8.0;HDR=Yes;") ' read only 'Set db = OpenDatabase(strSourceFile, False, False, "Excel 8.0;HDR=Yes;") ' write 'Set db = OpenDatabase( "C:\Foldername\Filename.xls", False, True, _ "Excel 8.0;HDR=Yes;") ' sola lettura 'Set db = OpenDatabase("C:\Foldername\Filename.xls", False, False, _ "Excel 8.0;HDR=Sì;") ' write On Error GoTo 0 If db Is Nothing Then MsgBox "Impossibile trovare il file!", vbExclamation, ThisWorkbook.Name Exit Sub End If ' ' elenca i nomi dei fogli di lavoro ' For f = 0 To db.TableDefs.Count - 1 ' Debug.Print db.TableDefs(f).Name ' Next f ' apre un recordset In caso di errore Riprendi successivo Set rs = db.OpenRecordset(strSQL) ' Set rs = db.OpenRecordset( "SELECT * FROM [SheetName$]") ' Set rs = db.OpenRecordset("SELECT * FROM [SheetName$] " & _ "WHERE [Nome campo] LIKE 'A*'") ' Set rs = db.OpenRecordset("SELECT * FROM [NomeFoglio$] " & _ "WHERE [Nome campo] LIKE 'A*' ORDER BY [Nome campo]" ) On Error GoTo 0 If rs Is Nothing Then MsgBox "Impossibile aprire il file!", vbExclamation, ThisWorkbook.Name db.Close Set db = Nothing Exit Sub End If RS2WS rs, TargetCell rs.Close Set rs = Nothing db. Close Set db = Nothing End Sub Sub RS2WS(rs As DAO.Recordset, TargetCell As Range) Dim f As Integer, r As Long, c As Long Se rs è nulla, quindi esci da Sub Se TargetCell non è nulla, quindi esci da Sub con applicazione .Calculation = xlCalculationManual .ScreenUpdating = False .StatusBar = "Scrittura dati dal recordset… " End With With TargetCell.Cells(1, 1) r = .Row c = .Column End With With TargetCell.Parent .Range(.Cells(r, c ), .Cells(.Rows.Count, c + rs.Fields.Count - 1)).Cancella 'cancella contenuto esistente' scrivi intestazioni di colonna Per f = 0 To rs.Fields.Count - 1 In caso di errore Riprendi successivo .Cells( r, c + f).Formula = rs.Fields(f).Name On Error GoTo 0 Next f ' write rec ords On Error Resume Next rs.MoveFirst On Error GoTo 0 Do While Not rs.EOF r = r + 1 For f = 0 To rs.Fields.Count - 1 On Error Resume Next .Cells(r, c + f).Formula = rs.Fields(f).Value On Error GoTo 0 Next f rs.MoveNext Loop .Rows(TargetCell.Cells(1, 1).Row).Font.Bold = True .Columns("A:IV").AutoFit End With With Application .StatusBar = False .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub
Gli esempi di macro presuppongono che il progetto VBA abbia aggiunto un riferimento alla libreria di oggetti DAO.
Puoi farlo dall'interno del VBE selezionando il menu Strumenti, Riferimenti e selezionando Microsoft DAO x.xx Object Library.
