[Resolvido]Exportacao de Consulta para Excel com Erro 3078

Bom dia. * Uso o Access 2003

Após buscas achei a rotina abaixo do colega JPaulo para exportação de uma Consulta a uma planilha Excel, mas aconteceu o seguinte:

1) Abre a Planilha 'DadosRelatorio.xls' em branco
2) Apresenta a mensagem de erro 3078 - "O mecanismo de banco de dados microsoft jet não encontrou a tabela de entrada ou consulta '12/06/2018'. Certifique-se de que ela existe e de que seu nome está digitado corretamente."
3) Ao Depurar aponta para a linha (em vermelho): Set Rst1 = CurrentDb.OpenRecordset(strSQL1, dbOpenDynaset)

Já estão marcadas as Referencias:
Microsoft Office 11.0 Object Library
Microsoft Access 11.0 Object Libray
Microsoft Excel 11.0 Object Library

Onde estaria o erro?

Também gostaria de incluir nessa rotina o seguinte:
1) Após o último registro acrescentar uma linha em branco.
2) Após essa linha em branco: Uma contagem total de linhas da 1ª coluna (A) após o último registro, com o texto: "Total de Evidências: " + Total de linhas
3) Na mesma linha do item acima: Um somatório (campo numérico com 2 casas decimais) da 5ª coluna (E), com o texto: "Total em GB" + Soma

Public Sub CriaExcel()
'By JPaulo Maximo Access
Dim strLivro As String, xls As Object
Dim db As DAO.Database
Dim rst, Rst1 As DAO.Recordset
Dim strSQL, strSQL1 As String
Dim x As String
Dim y As String
Dim z As String

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

strLivro = "C:\LAF\DadosRelatorio.xls" 'MODIFICADO
xls.Workbooks.Open (strLivro)
xls.Visible = True

strSQL = "SELECT * FROM C00_DadosRelatorio;" 'MODIFICADO

Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
With rst

.MoveFirst

Do Until .EOF
z = rst.Fields.Item(1) 'nome da consulta na tabela
x = rst.Fields.Item(2) 'nome do sheet na tabela
y = rst.Fields.Item(3) 'nome da celula na tabela

strSQL1 = z

Set Rst1 = CurrentDb.OpenRecordset(strSQL1, dbOpenDynaset)
xls.Worksheets(x).Activate
xls.ActiveSheet.Range(y).Select

Dim i As Integer
Dim iNumCols As Integer
iNumCols = Rst1.Fields.Count
For i = 1 To iNumCols
xls.Cells(1, i).value = Rst1.Fields(i - 1).Name

xls.Cells(1, i).Font.Bold = True 'cabeçalhos em negrito           - Inserido pelo usuário Daluque
xls.Cells(1, i).EntireColumn.AutoFit 'Dimensionamento das colunas - Inserido pelo usuário Daluque

Next

xls.ActiveCell.CopyFromRecordset Rst1
rst.MoveNext

Loop

End With
rst.Close
Rst1.Close
xls.ActiveWorkbook.Save
xls.Application.Quit
Set xls = Nothing
End Sub

Dando Up

Up

Marque um ponto de interrupção na linha onde o erro ocorre, execute-o e veja qual o valor que a variável SQL1 terá. Aí então certifique-se de que no seu banco existe uma tabela ou consulta com o nome que essa variável recebe pois o erro aponta pra tabela ou consulta inexistente.

Vou verificar e informo depois

Você tem de ter uma tabela com 3 campos:
nome da consulta
nome do sheet do Excel
nome da celula do Excel, exemplo A2

Caro IvanJr.

Após suas orientações, ficou como imagem abaixo:


A variável strSQL1 = "03/07/2018" => Valor do 1º registro no campo 'DataEntrada' da consulta 'C00_DadosRelatorio'.

Caro JPaulo:

Minha consulta 'C00_DadosRelatorio' tem 5 campos, conforme imagem abaixo:



A consulta é baseada em 2 tabelas, conforme mostrado na imagem, nesse caso, como alterar o código?

O amigo não está a entender a mecânica da coisa.

strSQL á tabela com os 3 campos que lhe passei acima.

strSQL1 é a string z, que será o nome da consulta que deve estar na tabela.

Sim, amigo,
após mais algumas tentativas, não consegui fazer, então realmente não consegui entender a mecânica da coisa

Anexe aqui parte do seu banco por favor.

Boa tarde,

Segue arquivo em anexo.

PS: para testar, crie o caminho C:\LAF

Olá;

Na sua pasta em C:\LAF, coloque lá este excel.
Download


Banco aqui para testar;
Download

Bom dia,

Mais simples que isso, impossível. Vivendo e aprendendo. Valeu mesmo.

Como havia solicitado no início deste tópico:

Também gostaria de incluir nessa rotina o seguinte:
1) Após o último registro acrescentar uma linha em branco.
2) Após essa linha em branco: Uma contagem do total de linhas da 1ª coluna após o último registro, com o texto: "Total de Evidências: " + Total de linhas (A2 até último)
3) Na mesma linha do item acima: Um somatório (campo numérico com 2 casas decimais) da 5ª coluna (E), com o texto: "Total em GB" + Soma (E2 até último)

Consegui resolver o item 2:
2) Após essa linha em branco: Uma contagem do total de linhas da 1ª coluna após o último registro, com o texto: "Total de Evidências: " + Total de linhas (A2 até último)

Toda rotina, após
'End With'
Acrescentei os comandos:
Dim ContaDados As Integer
ContaDados = DCount("*", "C00_DadosRelatorio")
xls.ActiveSheet.Cells(ContaDados + 2, 1) = "Total de Evidências: " & ContaDados

Agora falta resolver os itens 1 e 3, conforme mensagem anterior.
No aguardo de ajuda ...

Olá Vilmen;

Desculpe a demora, mas isto está sempre no RED LINE.

Seu código todo corrigido aqui;

Código:

Public Sub CriaExcel()
'By JPaulo Maximo Access
' Requer Ferramentas\Referencias e ativar a Referencia Microsoft Excel xx.0 Object Library
Dim strLivro As String
Dim xls As Object
Dim db As DAO.Database
Dim rst, Rst1 As DAO.Recordset
Dim strSQL, strSQL1 As String
Dim x As String
Dim y As String
Dim z As String
   
Set db = CurrentDb
Set xls = CreateObject("Excel.Application")

strLivro = "C:\LAF\DadosRelatorio.xls" 'MODIFICADO
xls.Workbooks.Open (strLivro)
xls.Visible = True

strSQL = "SELECT * FROM tblExporta;" 'TABELA com o nome da consulta, nome da folha no excel e nome da celula no excel

Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
With rst

.MoveFirst

Do Until .EOF
z = rst.Fields.Item(0) 'nome da consulta na tabela
x = rst.Fields.Item(1) 'nome do sheet na tabela
y = rst.Fields.Item(2) 'nome da celula na tabela

strSQL1 = z

Set Rst1 = CurrentDb.OpenRecordset(strSQL1, dbOpenDynaset)
xls.Worksheets(x).Activate
xls.ActiveSheet.Range(y).Select

Dim i As Integer
Dim iNumCols As Integer
iNumCols = Rst1.Fields.Count
For i = 1 To iNumCols
xls.Cells(1, i).value = Rst1.Fields(i - 1).Name

xls.Cells(1, i).Font.Bold = True    'cabeçalhos em negrito      - Inserido pelo usuário Daluque
xls.Cells(1, i).EntireColumn.AutoFit 'Dimensionamento das colunas - Inserido pelo usuário Daluque

Next

xls.ActiveCell.CopyFromRecordset Rst1
rst.MoveNext

Loop

End With

Dim UltimaLinha%
Dim ContaDados%
Dim SomaColuna As Long
UltimaLinha = xls.Cells(xls.Rows.Count, 1).End(xlUp).Row

xls.ActiveSheet.Range("A" & UltimaLinha + 2).Select
ContaDados = Nz(DCount("*", "C00_DadosRelatorio"), 0)
xls.ActiveSheet.Range("A" & UltimaLinha + 2) = "Total de Evidências: " & ContaDados

xls.ActiveSheet.Range("E" & UltimaLinha + 2).Formula = "=sum(E2:E" & UltimaLinha & ")"
xls.ActiveSheet.Range("E" & UltimaLinha + 2) = "Total em GB: " & xls.ActiveSheet.Range("E" & UltimaLinha + 2)
xls.ActiveSheet.Range("E" & UltimaLinha + 2).EntireColumn.AutoFit

rst.Close
Rst1.Close
xls.ActiveWorkbook.Save
xls.Application.Quit
Set xls = Nothing
End Sub

Perfeito. Mais uma vez muito obrigado pela ajuda.
Você é o cara!

Fico feliz.

Obrigado pelo retorno o forum agradece.

Boa tarde,

Preciso utilizar essa mesma função só que em vez de exportar os dados por linha preciso que seja em coluna e limitar a uma quantidade de 7 registro, tem como eu fazer isso?

Grato

Boa tarde, Dery

Eu não saberia lhe ajudar nisso, mas aconselho a abrir um novo tópico seu para essa questão, e se quiser pode até mencionar esse meu como referênca (https://www.maximoaccess.com/t34930-resolvidoexportacao-de-consulta-para-excel-com-erro-3078).
Acredito que alguém poderá lhe ajudar com mais eficácia.

Boa sorte.

Valeu obrigado.