Adapte o código abaixo para a sua necessidade:
' Ligue a Referência: Microsoft ActiveX Data Objects 2.8 Library
' Biblioteca de Accesso à Dados
Private Sub Tabela_Access()
Dim cnnBco As New ADODB.Connection
Dim rstReg As New ADODB.Recordset
Dim strCnn As String
Dim strArq As String
Dim intCol As Integer
Dim varCol As Variant
Dim wksReg As Worksheet
Dim varMarcador As Variant
' Endereço do Arquivo de Banco de Dados
strArq = ActiveWorkbook.Path & "dataNome_do_Arquivo_Access.accdb" ' neste caso está considerando que o caminho está no mesmo diretório do arquivo Excel aberto
' String de Conexão
strCnn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strArq & ";" & _
"Persist Security Info=False"
' Abertura da Conexão com o Banco de Dados
With cnnBco
.CursorLocation = adUseClient
.ConnectionString = strCnn
.Open
End With
' Abertura da Tabela Regiões
rstReg.Open "[Nome_da_tabela_Access]", cnnBco, adOpenDynamic, adLockOptimistic
'Criar Lista
Set wksReg = Sheets("Nome_da_Planilha_onde_vai_copiar_a_tabela")
' Selecionando a Planilha e Limpando as Células
With wksReg
.Select
.Cells.Clear
End With
' Lendo nome dos Campos
intCol = 1
For Each varCol In rstReg.Fields
wksReg.Cells(1, intCol).Value = varCol.Name
intCol = intCol + 1
Next varCol
' Descarregando os registros
varMarcador = rstReg.Bookmark
rstReg.MoveFirst
wksReg.Range("A2").CopyFromRecordset rstReg
rstReg.Bookmark = varMarcador
'fechar conexão
rstReg.Close
cnnBco.Close
End Sub
Rafael Issamu F. Kamimura
Moderador Oficial Microsoft Community - MCC (Contribuidor do Microsoft Community)
http://zip.net/bjrt0X - http://zip.net/bhrvbR
Foi útil? Clique na mãozinha
Conheça: http://excelmaniacos.com/
Postado : 02/03/2015 10:37 am