Boas
Utilizo o código VBA abaixo para trazer dados de uma consulta do access para o excel e funciona de acordo com minhas necessidades.
Porem tenho uma outra consulta de referencia cruzada (CstAtend) com critério "MesAno" e não não estou conseguindo ajustar o código
para que o critério seja definido no excel e a consulta seja executada de acordo e preencher as celulas.
Agradeceria uma ajuda nisso.
Utilizo o código VBA abaixo para trazer dados de uma consulta do access para o excel e funciona de acordo com minhas necessidades.
Porem tenho uma outra consulta de referencia cruzada (CstAtend) com critério "MesAno" e não não estou conseguindo ajustar o código
para que o critério seja definido no excel e a consulta seja executada de acordo e preencher as celulas.
Agradeceria uma ajuda nisso.
- Código:
Sub ImportarDadosDoAccess()
Dim db As Object ' Objeto do Access
Dim rs As Object ' Recordset do Access
Dim strSQL As String
Dim Provider As String
Dim ws As Worksheet
Dim celula As Range
Dim coluna As Integer
Dim conexao As ADODB.Connection
Set conexao = New ADODB.Connection
' Caminho para o banco de dados
Dim strCaminho As String
'strCaminho = ThisWorkbook.Path & "\Database1.accdb" ' Substitua pelo caminho do seu banco de dados do Access 2010
strCaminho = ThisWorkbook.Path & "\Sis.mdb"
'Provider = "Provider=Microsoft.ACE.OLEDB.12.0;"
' Consulta SQL para selecionar os dados
strSQL = "SELECT * FROM CstCasosporAssistSocial" ' Substitua "NomeDaTabela" pelo nome da sua tabela ou consulta
' Cria uma instância do objeto do Access
Set db = CreateObject("Access.Application")
' Abre o banco de dados do Access
db.OpenCurrentDatabase strCaminho
' Define a consulta SQL como Recordset
Set rs = db.CurrentDb.OpenRecordset(strSQL)
' Define a planilha onde os dados serão inseridos
Set ws = ThisWorkbook.Sheets("Plan1") ' Substitua "Planilha1" pelo nome da sua planilha no Excel
' Define a célula inicial onde os dados serão inseridos
Set celula = ws.Range("A1")
' Adiciona os cabeçalhos das colunas
For coluna = 0 To rs.Fields.Count - 1
celula.Offset(0, coluna).Value = rs.Fields(coluna).Name
Next coluna
' Move para a próxima linha para começar a adicionar os dados
Set celula = celula.Offset(1, 0)
' Adiciona os dados
Do While Not rs.EOF
For coluna = 0 To rs.Fields.Count - 1
celula.Offset(0, coluna).Value = rs.Fields(coluna).Value
Next coluna
rs.MoveNext
Set celula = celula.Offset(1, 0)
Loop
' Fecha o Recordset
rs.Close
' Fecha o banco de dados do Access
db.Quit
' Libera os objetos da memória
Set rs = Nothing
Set db = Nothing
For Each celula In ws.Range("1:1")
If Not IsEmpty(celula) Then
celula.Font.Bold = True
celula.Font.Size = 14
End If
Next celula
For Each celula In ws.UsedRange
If Not IsEmpty(celula) Then
celula.HorizontalAlignment = xlCenter
celula.EntireColumn.AutoFit
celula.EntireRow.AutoFit
With celula.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Next celula
End Sub