Use uma pasta de trabalho fechada como um banco de dados (ADO) usando VBA no Microsoft Excel

Anonim

Com os procedimentos a seguir, você pode usar o ADO para recuperar um conjunto de registros de uma pasta de trabalho fechada e ler / gravar dados.
Chame o procedimento assim:

GetWorksheetData "C: FoldernameFilename.xls", "SELECT * FROM [SheetName $];", ThisWorkbook.Worksheets (1) .Range ("A3")
Substitua SheetName pelo nome da planilha da qual deseja recuperar os dados.

Sub GetWorksheetData (strSourceFile As String, strSQL As String, TargetCell As Range)
Dim cn As ADODB.Connection, rs As ADODB.Recordset, f As Integer, r As Long
Se TargetCell não for nada, saia do Sub
Definir cn = Novo ADODB.Connection
Em caso de erro, continuar próximo
cn.Open "DRIVER = {Microsoft Excel Driver (* .xls)}; DriverId = 790; ReadOnly = True;" & _
"DBQ =" & strSourceFile & ";"
'DriverId = 790: Excel 97/2000
'DriverId = 22: Excel 5/95
'DriverId = 278: Excel 4
'DriverId = 534: Excel 3
No erro GoTo 0
Se cn não for nada, então
MsgBox "Não foi possível encontrar o arquivo!", VbExclamation, ThisWorkbook.Name
Sair do Sub
Fim se

'abrir um conjunto de registros
Definir rs = Novo ADODB.Recordset
Em caso de erro, continuar próximo
rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
'rs.Open "SELECT * FROM [SheetName $]", _
cn, adOpenForwardOnly, adLockReadOnly, adCmdText
'rs.Open "SELECT * FROM [SheetName $]", _
cn, adOpenStatic, adLockOptimistic, adCmdText
'rs.Open "SELECT * FROM [SheetName $] WHERE [Field Name] LIKE' A% '", _
cn, adOpenStatic, adLockOptimistic, adCmdText
'rs.Open "SELECT * FROM [SheetName $] WHERE [Field Name] LIKE' A% 'ORDER BY [Field Name]", _
cn, adOpenStatic, adLockOptimistic, adCmdText

'maneiras opcionais de recuperar um conjunto de registros
'Definir rs = cn.Execute ("[A1: Z1000]")' primeira planilha
'Defina rs = cn.Execute ("[DefinedRangeName]")' qualquer planilha

No erro GoTo 0
Se rs não for nada, então
MsgBox "Não é possível abrir o arquivo!", VbExclamation, ThisWorkbook.Name
cn.Fechar
Definir cn = Nada
Sair do Sub
Fim se

RS2WS rs, TargetCell
Abordagem opcional de 'TargetCell.CopyFromRecordset rs' para Excel 2000 ou posterior

If rs.State = adStateOpen Then
rs.Fechar
Fim se
Definir rs = Nada
cn.Fechar
Definir cn = Nada
End Sub

O exemplo de macro pressupõe que seu projeto VBA adicionou uma referência à biblioteca de objetos ADO.
Você pode fazer isso de dentro do VBE selecionando o menu Ferramentas, Referências e selecionando Microsoft
Biblioteca de objetos ActiveX Data Objects x.x.