[Resolvido]Exportar consulta * filtrada * com data inicial e final para uma planilha do Excel

Prezados bom dia / boa tarde / boa noite.

Precisa de uma ajuda !!!

Estou a usar o Access 2013 32 bits, antes usava o 2010 32bits.

Estou com uma dificuldade de exportar uma consulta filtrada para o Excel para gerar um gráfico, coisa que no Access 2010 era nativo dele gerar o gráfico.

Tenho os seguintes campos nessa consulta conforme a figura abaixo:



Só que quando faço a exportação, não está sendo respeitada a filtragem na coluna data pedido.

Alguém pode me dar uma força nesse caso ?

Desde já, meus agradecimentos.

Abraços.

Estou a utilizar uma rotina criada pelo JPaulo, com uma modificação....mas mesmo assim....todos os dados estão indo, não está ocorrendo a filtragem.

Public Sub CriaExcel()
'By JPaulo Maximo Access
'2017-09-15
Dim strLivro As String
Dim xls As Object
Dim db As Database
Dim rst As DAO.Recordset
Dim strSQL
Dim intUltimaCelula%
Dim xlsht As Excel.Worksheet



Set db = CurrentDb
Set xls = CreateObject("Excel.Application")
strLivro = "C:\teste.xlsx" 'diretorio completo do ficheiro
xls.Workbooks.Open (strLivro)
Set xlsht = xls.Worksheets(1) ' 1 é o primeiro sheet
xls.Visible = True 'torna o excel visivel

strSQL = "SELECT * FROM QrygraficoVendas Where DataPedido = between " & Format(Forms!frmbuscagrafico!di, "dd-mm-yyyy") & "#" And Format(Forms!frmbuscagrafico!df, "dd-mm-yyyy") & "#"

Set rst = CurrentDb.OpenRecordset(strSQL)

If rst.RecordCount = 0 Then Exit Sub 'se não tem registros, morre aqui
xls.Worksheets(1).Activate
xls.ActiveSheet.Range("A1").Select 'seleciona a primeira celula
intUltimaCelula = xlsht.Cells(xlsht.Rows.Count, 1).End(xlUp).Row 'obtem a ultima celula preenchida
intUltimaCelula = intUltimaCelula + 1 'acrescenta mais uma celula, que será a vazia
xls.ActiveSheet.Range("A" & intUltimaCelula).Select 'seleciona-a
xls.ActiveCell.CopyFromRecordset rst 'copia os dados da consulta

'fecha o recordset e limpa a memoria
rst.Close: Set rst = Nothing
'salva o excel
xls.ActiveWorkbook.Save
'fecha o excel
xls.Application.Quit
'limpa a memoria
Set xls = Nothing
End Sub


Em vermelho, onde ocorre o erro.

Silvio,

Instrução SQL está equivocada. Segue correção:

Código:


    strSQL = "SELECT * FROM QrygraficoVendas "
    strSQL = strSQL & " WHERE DataPedido BETWEEN #" & Format(Forms!frmbuscagrafico!di, "dd-mm-yyyy") & "#"
    strSQL = strSQL & " AND #" & Format(Forms!frmbuscagrafico!df, "dd-mm-yyyy") & "#"


É isso

Alexandre, boa tarde.

Grato por me estar dando uma força, mas, devo lhe dizer que .....não surtiu o efeito desejado na exportação do mesmo.

Em anexo, apenas as partes envolvidas para uma melhor compreensão.

Coloque como data inicial e final apenas o mês de março, irá ver que vai entrar o mês de abril junto no Excel.

Se puder me ajudar eu fico agradecido.

Abraços.

Ok Silvio,

Vou baixar e analisar.

Ate+

Silvio,

O filtro não vai funcionar de jeito nenhum!!! rssss
Existem 2 equivocos que seguem:

1 - instrução para carregar o recordset vem antes do SELECT para carregá-lo. Essa instrução tem ir depois de montar a string com a instrução.
2 - A formatação de data também está incorreta. Deve se usar o formato "mm/dd/yyyy"



Segue correção do código:

Código:



    '-- Montar a string para carregar o recordset
    strSQL = "SELECT * FROM QryGraficoVendas "
    strSQL = strSQL & " WHERE DataPedido BETWEEN #" & Format(Forms!FrmBuscaGrafico!di, "mm/dd/yyyy") & "#"
    strSQL = strSQL & " AND #" & Format(Forms!FrmBuscaGrafico!df, "mm/dd/yyyy") & "#"
    
    '-- CArregar recordset conforme instrução SQL
    Set rst = CurrentDb.OpenRecordset(strSQL)
    




É isso

Alexandre.....nada de filtrar ainda.....

Mesmo com as alterações que me passou, não ocorre a filtragem.

Do jeito que me passou, fiz a inclusão, será que eu posso ter errado, equivocado em algo ??

Public Sub CriaExcel()
'By JPaulo Maximo Access
'2017-09-15
Dim strLivro As String
Dim xls As Object
Dim db As Database
Dim rst As DAO.Recordset
Dim strSQL
Dim intUltimaCelula%
Dim xlsht As Excel.Worksheet



Set db = CurrentDb
Set xls = CreateObject("Excel.Application")

strLivro = "C:\teste.xlsx" 'diretorio completo do ficheiro
xls.Workbooks.Open (strLivro)
Set xlsht = xls.Worksheets(1) ' 1 é o primeiro sheet
xls.Visible = True 'torna o excel visivel


'-- Montar a string para carregar o recordset
strSQL = "SELECT * FROM QryGraficoVendas "
strSQL = strSQL & " WHERE DataPedido BETWEEN #" & Format(Forms!FrmBuscaGrafico!di, "mm/dd/yyyy") & "#"
strSQL = strSQL & " AND #" & Format(Forms!FrmBuscaGrafico!df, "mm/dd/yyyy") & "#"
'-- CArregar recordset conforme instrução SQL
Set rst = CurrentDb.OpenRecordset(strSQL)


If rst.RecordCount = 0 Then Exit Sub 'se não tem registros, morre aqui
xls.Worksheets(1).Activate
xls.ActiveSheet.Range("A1").Select 'seleciona a primeira celula
intUltimaCelula = xlsht.Cells(xlsht.Rows.Count, 1).End(xlUp).Row 'obtem a ultima celula preenchida
intUltimaCelula = intUltimaCelula + 1 'acrescenta mais uma celula, que será a vazia
xls.ActiveSheet.Range("A" & intUltimaCelula).Select 'seleciona-a
xls.ActiveCell.CopyFromRecordset rst 'copia os dados da tabela




'fecha o recordset e limpa a memoria
rst.Close: Set rst = Nothing
'salva o excel
xls.ActiveWorkbook.Save
'fecha o excel
xls.Application.Quit
'limpa a memoria
Set xls = Nothing
End Sub

Silvio,

Retire o critério que está na consulta. É por isso que não está funcionando.
Você já esta filtrando os dados via código.




E acredito que vai funfar !!!!

Alexandre, boa tarde novamente..

Mesmo retirando o critério na consulta, não filtrou !!

O que eu fiz...

Código:

Public Sub CriaExcel()

Dim strConsulta, strNomePLanilha
Dim contaReg As Integer
strConsulta = "QryExportaComissao"
strNomePLanilha = "c:/Grafico/Grafico.xls" ' criar a pasta para receber o arquivo
contaReg = DCount("Representada", "QryGraficoVendas")


If MsgBox("Deseja exportar " & contaReg & " registros ?", vbYesNo, Me.Caption) = vbNo Then
MsgBox "Ação cancelada pelo usuário !", vbInformation, Me.Caption
Exit Sub

Else
'criando a pasta na raiz do drive C
On Error Resume Next
If Len(Dir("C:\Grafico", vbDirectory) & "") > 0 Then
MsgBox "Esta pasta já existe"
Else
MkDir "C:\Grafico"
End If

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strConsulta, strNomePLanilha

MsgBox "Foram exportados para a planilha grafico.XLS um total de...  " & contaReg & " Registros !", vbInformation, Me.Caption

    End If
    

End Sub

Desse modo que está acima, mesmo mantendo o critério na data do pedido, ele filtra a consulta e faz a exportação para o Excel.

No Access 2010 o gráfico era nativo e fácil de montar.   Agora no 2013 para frente, não temos mais esse recurso nele o que é uma pena.

Agradeço imensamente a tua ajuda e disposição em me ajudar...agradeço mesmo.

Abraços.

Silvio,

Eu rodei sua aplicação aqui no meu Access 2016 e gerou a planilha normal e sem erros.

Boa sorte e sucesso.
O forum sempre a agradece.

Abs