Abaixo segue um  código que muito me agrada! Não depender de criar uma fonte de dados ODBC para intermediar o banco e na e na própria planilha fazer consultas direto ao banco usando sql.

Eu uso uma base de dados oracle vba, mas também serve para base de dados access com vba (.mdb). O segundo código mais abaixo

Em ambos os casos (oracle ou access) é necessário adicionar a biblioteca ADO para conexão.

 

 

<<<<<Codigo Oracle Vba>>>>>

Private Sub cmdConexaoBD_Click()

Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Integer

'define a conexão com o banco de dados
Set cn = New ADODB.Connection

cn.CursorLocation = adUseClient

cn.Open "Driver={Microsoft ODBC for Oracle}; " & _
"CONNECTSTRING=database;uid=usuario;pwd=senha;"

'define um novo objeto recordset (gravar resultado na variavel)
Set rs = New ADODB.Recordset

'define a instrução sql
sql = "SELECT NOME, CODIGO FROM TA_SITUACOES"

'gera o recordset para o sql sobre a conexao definida
rs.Open sql, cn

'define o cabeçalho das células no excel
Range("A1").Value = "NOME"
Range("B1").Value = "CODIGO"

'Retorno dos dados para excel, onde "i" é o contador e "EOF" fim dos dados
i = 1

If Not rs.EOF Then

Do While Not rs.EOF

Range("A" & i + 1).Value = rs(0)
Range("B" & i + 1).Value = rs(1)
rs.MoveNext
i = i + 1

Loop

End If

cn.Close

End Sub

_________________________________________________________________

 

<<<<<Codigo ACCESS VBA>>>>>

Private Sub cmdConexaoBD_Click()

Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Integer
'define a conexão com o banco de dados Northwind.mdb
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:/teste/Northwind.mdb"
cn.Open
'define um novo objeto recordset
Set rs = New ADODB.Recordset
'define a instrução sql
sql = "SELECT Orders.CustomerID, Sum([Order Details].UnitPrice) AS ValorTotal, Sum([Order Details].Quantity) AS QuantidadeTotal"
sql = sql & " FROM (Customers INNER JOIN Orders ON Customers.CustomerID = Orders.CustomerID) "
sql = sql & " INNER JOIN [Order Details] ON Orders.OrderID = [Order Details].OrderID"
sql = sql & " GROUP BY Orders.CustomerID"
sql = sql & " ORDER BY Orders.CustomerID"
'gera o recordset para o sql sobre a conexao definida
rs.Open sql, cn
'define o cabeçalho das células no excel
Range("A1").Value = "Codigo do Cliente"
Range("B1").Value = "Quantidade Total"
Range("C1").Value = "Valor total dos Pedidos"

i = 2
If Not rs.EOF Then
Do While Not rs.EOF
Range("A" & i).Value = rs(0)
Range("B" & i).Value = rs(2)
Range("C" & i).Value = rs(1)
rs.MoveNext
i = i + 1
Loop
End If

cn.Close

End Sub

 

Fontes de pesquisa:
http://www.macoratti.net/vba_xls1.htm
http://social.msdn.microsoft.com/Forums/pt-BR/vbapt/thread/0a28ae49-98be-4ceb-84b8-cc80d925ddb9

Vídeo Recomendado: