[Resolvido]Auda para ajustar codigo de consulta para do excel

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.

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

Olá Alcide,

Vai se movido para outra sala Off-Topic, pois este código é executado a partir do Excel.

Verifique se não é o formato da data, o Access é muito patriota e pode ser isso:
https://www.maximoaccess.com/t27705-resolvidoajuda-no-criterio-entre-datas
https://www.maximoaccess.com/t27705-resolvidoajuda-no-criterio-entre-datas

Boa sorte
Abraço

Assunto resolvido. agradeço a colaboração.