[Resolvido]Exportação de dados de uma consulta

Boa noite senhores,
venho mais uma vez pedir uma grande ajuda.
Encontrei uma rotina com procedimento de exportação de dados de uma tabela para o formato Excell.
Funciona muito bem quando referencio uma tabela. Mas apresenta erro quando me refiro a uma consulta.
É um pequeno sistema de controle de alunos. Existe um tabela de ALUNOS e uma MATRICULAS.
Em MATRICULAS tenho a sigla do curso e código do ALUNO.
Fiz um formulário onde pode-se escolher a Turma para exportação

Segue a rotina:

Private Sub Bt_exportar_Click()
 DoCmd.OpenQuery "Cns_Alunos_coincidentes_Tbl_Matriculas"
 
 Dim appExcel As Object 'Excel.Application
 Dim objWorkbook As Object 'Excel.Workbook
 Dim objWorksheet As Object 'Excel.Worksheet
 Dim rst As ADODB.Recordset
 Dim cnn As ADODB.Connection
 
 Dim lngCol As Long
 Dim strDB As String
 Dim strSql As String
 
 Set cnn = New ADODB.Connection
 'Adeque a cadeia de conexão de sua base de dados:
 cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
 "Data Source=" & CurrentProject.FullName & ";"
 cnn.Open
 
 'Selecione a tabela desejada alterando a consulta abaixo:
   
 ' strSql = "SELECT * FROM [Cns_Alunos_coincidentes_Tbl_Matriculas]"
 
 strSql = "SELECT * FROM [Tbl_Alunos]"
 Set rst = cnn.Execute(strSql)
 
 'Cria aplicação / pasta de trabalho / planilha no Excel:
 On Error Resume Next
 Set appExcel = GetObject(, "Excel.Application")
 If appExcel Is Nothing Then
 Set appExcel = CreateObject("Excel.Application")
 End If
 On Error GoTo 0
 appExcel.Visible = True
 
 Set objWorkbook = appExcel.Workbooks.Add(-4167) 'xlWBATWorksheet
 Set objWorksheet = objWorkbook.Worksheets(1)
 
 With objWorksheet
   'Exporta dados do objeto Recordset na planilha:
   .Range("A2").CopyFromRecordset rst
     
   'Copia cabeçalho na planilha:
   For lngCol = 0 To rst.Fields.Count - 1
     .Range("A1").Offset(, lngCol) = rst.Fields(lngCol).Name
   Next lngCol
 End With
   
 'Opcional. Salva pasta de trabalho no mesmo caminho da base de dados:
 objWorkbook.SaveAs CurrentProject.Path & "\Tbl_Alunos", 51 'xlOpenXMLWorkbook
 appExcel.Quit
 
 'Fecha conexões e limpa memória:
 rst.Close
 cnn.Close
 Set rst = Nothing
 Set cnn = Nothing
End Sub

Anexei a imagem com o erro quando substitui a tabela pela consulta.

Desde já agradeço muito por qualquer ajuda.
Helena Barbosa

A imagem do Erro não veio!

Complementando, eu utilizo Access 2010.

A mensagem é:
Erro em tempo de execução: -2147217904 (80040e10)
Nenhum valor foi fornecido para um ou mais parâmetros necessários

Obrigada

Certo... Acredito que essa sua consulta tenha algum criterio dessa forma: [formularios]·[nomeformulario]...
E ao passar pro VB ele nao entendera...


Coloque ali todo o Sql da consulta e altere o criterio para a forma correta do VB.

Se ficar duvidas posta aqui o exemplo.

Oi Fabio,
continuo tentando, mas sem sucesso.
Coloquei a consulta como você orientou, mas nada ainda.
Continua com o mesmo erro.

***********************************************************************


Private Sub Bt_exportar_Click()
DoCmd.OpenQuery "Cns_Alunos_coincidentes_Tbl_Matriculas"

Dim appExcel As Object 'Excel.Application
Dim objWorkbook As Object 'Excel.Workbook
Dim objWorksheet As Object 'Excel.Worksheet
Dim rst As ADODB.Recordset
Dim cnn As ADODB.Connection

Dim lngCol As Long
Dim strDB As String
Dim strSql As String

Set cnn = New ADODB.Connection
'Adeque a cadeia de conexão de sua base de dados:
cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & CurrentProject.FullName & ";"
cnn.Open

'Selecione a tabela desejada alterando a consulta abaixo:

' strSql = "SELECT * FROM [Tbl_Alunos]"

strSql = "SELECT Tbl_Matriculas.Sigla_Curso, Tbl_Alunos.Nome_Completo, Tbl_Alunos.Nome_Guerra, Tbl_Alunos.Foto, " _
& "Tbl_Alunos.CPF, Tbl_Alunos.Titulo_Eleitor, Tbl_Alunos.Zona_Eleitoral, Tbl_Alunos.Secao_Eleitoral, Tbl_Alunos.Banco," _
& "Tbl_Alunos.Agencia_Bancaria , Tbl_Alunos.Conta_corrente, Tbl_Alunos.Variacao_Bancaria, Tbl_Alunos.Nacionalidade," _
& "Tbl_Alunos.NIP , Tbl_Alunos.OM_Anterior, Tbl_Alunos.Vinculo_Aluno, Tbl_Alunos.Posto_Aluno, Tbl_Alunos.Corpo_Aluno," _
& "Tbl_Alunos.Sexo , Tbl_Alunos.Tipo_Sanguineo, Tbl_Alunos.Data_Nasc, Tbl_Alunos.RG, Tbl_Alunos.Orgao_Emissor," _
& "Tbl_Alunos.Data_Emissao , Tbl_Alunos.Data_Validade, Tbl_Alunos.Estado_Civil, Tbl_Alunos.Endereco, Tbl_Alunos.Complenento," _
& "Tbl_Alunos.Numero_Ender , Tbl_Alunos.Bairro, Tbl_Alunos.Cidade, Tbl_Alunos.UF, Tbl_Alunos.Pais, Tbl_Alunos.CEP," _
& "Tbl_Alunos.Tel_Residencial , Tbl_Alunos.Tel_Trabalho, Tbl_Alunos.Tel_Celular, Tbl_Alunos.email, Tbl_Alunos.Observacao," _
& "Tbl_Alunos.Contato_Aviso , Tbl_Alunos.Grau_Parentesco_Aviso, Tbl_Alunos.Tel_Aviso, Tbl_Alunos.Obs_Contato, " _
& "Tbl_Alunos.Veiculo_descricao , Tbl_Alunos.Veiculo_ano, Tbl_Alunos.Veiculo_cor, Tbl_Alunos.Veiculo_placa," _
& "Tbl_Alunos.Veiculo_Obs , Tbl_Alunos.Conjugue_Militar, Tbl_Alunos.Conjugue_militar_selecao, Tbl_Alunos.Conjugue_nome, " _
& "Tbl_Alunos.Conjugue_NIP , Tbl_Alunos.Conjugue_DtNasc, Tbl_Alunos.Conjugue_RG, Tbl_Alunos.Conjugue_Boletim, Tbl_Alunos.Conjugue_Obs," _
& "Tbl_Alunos.Cursos_Realizados , Tbl_Alunos.conceito, Tbl_Alunos.Aspectos_positivos, Tbl_Alunos.Aspectos_negativos" _
& " FROM Tbl_Alunos INNER JOIN Tbl_Matriculas ON Tbl_Alunos.[NIP] = Tbl_Matriculas.[NIP_Aluno_Matriculado] " _
& " WHERE ((Tbl_Matriculas.Sigla_Curso) Like [Formulários]![Frm_Relacao_Turmas_Exportacao]![Caixa_Sigla_Turma]);"



Set rst = cnn.Execute(strSql)



'Cria aplicação / pasta de trabalho / planilha no Excel:
On Error Resume Next
Set appExcel = GetObject(, "Excel.Application")
If appExcel Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
End If
On Error GoTo 0
appExcel.Visible = True

Set objWorkbook = appExcel.Workbooks.Add(-4167) 'xlWBATWorksheet
Set objWorksheet = objWorkbook.Worksheets(1)

With objWorksheet
'Exporta dados do objeto Recordset na planilha:
.Range("A2").CopyFromRecordset rst

'Copia cabeçalho na planilha:
For lngCol = 0 To rst.Fields.Count - 1
.Range("A1").Offset(, lngCol) = rst.Fields(lngCol).Name
Next lngCol
End With

'Opcional. Salva pasta de trabalho no mesmo caminho da base de dados:
objWorkbook.SaveAs CurrentProject.Path & "\Tbl_Alunos", 51 'xlOpenXMLWorkbook
appExcel.Quit

'Fecha conexões e limpa memória:
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub

Ola, dois tipos de erros:

1º Deve tomar cuidado nas quebra de Linha & _ pois dependendo de onde irá quebrar para próxima lina há a necessidade de colocar um Espaço Antes de quebrar a linha ou no Início da próxima linha. <== Verifique pois tem varias linha com esse Erro!

2º Lembre-se VB mesmo aparecendo pra vc em portugues, ele so entende o Ingles! Veja no critério que esta passando o Nome Formulário... Isso não sera compreendido pelo sistema.
Mude para:
& " WHERE ((Tbl_Matriculas.Sigla_Curso) Like Forms![Frm_Relacao_Turmas_Exportacao]![Caixa_Sigla_Turma]);"

Bom dia Fábio,
agradeço pela sua atenção, mas como não tenho experiência em sintaxes complexas, substitui a rotina pelo comando abaixo:


DoCmd.OutputTo ObjectType:=acOutputQuery, ObjectName:="Cns_Alunos_coincidentes_Tbl_Matriculas", OutputFormat:=acFormatXLS, Outputfile:="c:\Sistema Acadêmico\Exportacao\Alunos-" & [Forms]![Frm_Relacao_Turmas_Exportacao]![Caixa_Sigla_turma] & ".xls"

Está funcionando bem.

Mais uma vez obrigada pelo apoio.

Até a próxima, rsrs

Helena

A sim Helena! Se a consulta sera exportada completa para nova planilha do Excel o recomendado e dessa forma, pois e bem mais rápido do que o método anterior...

O método de abertura do Excel e inserção dos dados e recomendado quando você deve atualizar alguma planilha e ou inserir dados em locais/células especificas!

Grato pelo retorno amigo, até a próxima se Deus Quiser!