ERRO AO EXPORTAR PARA O EXCEL PELA 2ª VEZ
Senhores,
Criei um comando para exportar para o Excel a minha tabela “rsâ€.
Até ai está tudo certo, funcionou perfeitamente.
Porem ao clicar pela 2ª vez no botão gera o erro abaixo.
run-time error [ô]1004[ô] method [ô]range[ô] of object[ô]_global[ô] failed
Segue o código.
Private Sub cmd_excel_Click()
Dim FILTRO As String
connectdb
If cbc_for.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô]and FOR = [ô][Ô] & cbc_for.Text & [Ô][ô][Ô]
End If
rs.Open [Ô]select DATA_V,FOR from CAD_CP WHERE 1=1 [Ô] & FILTRO & [Ô]order by cod asc[Ô], db, 3, 3
Set EApp = CreateObject([Ô]excel.application[Ô])
Set EwkB = EApp.Workbooks.Add
Set EwkS = EwkB.Sheets(1)
EApp.Application.Visible = True
Range([Ô]B5[Ô]).CopyFromRecordset rs
Set rs = Nothing
db.Close: Set db = Nothing
End Sub
Em anexo imagem do mensagem de erro.
Criei um comando para exportar para o Excel a minha tabela “rsâ€.
Até ai está tudo certo, funcionou perfeitamente.
Porem ao clicar pela 2ª vez no botão gera o erro abaixo.
run-time error [ô]1004[ô] method [ô]range[ô] of object[ô]_global[ô] failed
Segue o código.
Private Sub cmd_excel_Click()
Dim FILTRO As String
connectdb
If cbc_for.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô]and FOR = [ô][Ô] & cbc_for.Text & [Ô][ô][Ô]
End If
rs.Open [Ô]select DATA_V,FOR from CAD_CP WHERE 1=1 [Ô] & FILTRO & [Ô]order by cod asc[Ô], db, 3, 3
Set EApp = CreateObject([Ô]excel.application[Ô])
Set EwkB = EApp.Workbooks.Add
Set EwkS = EwkB.Sheets(1)
EApp.Application.Visible = True
Range([Ô]B5[Ô]).CopyFromRecordset rs
Set rs = Nothing
db.Close: Set db = Nothing
End Sub
Em anexo imagem do mensagem de erro.
FFABIOG,
Veja isso:
=================================================================================
http://stackoverflow.com/questions/12174723/run-time-error-1004-method-range-of-object-global-failed
Run-time error [ô]1004[ô] : Method [ô]Range[ô] of object[ô]_Global[ô] failed
When you reference Range like that it[ô]s called an unqualified reference because you don[ô]t specifically say which sheet the range is on. Unqualified references are handled by the [Ô]_Global[Ô] object that determines which object you[ô]re referring to and that depends on where your code is.
If you[ô]re in a standard module, unqualified Range will refer to Activesheet. If you[ô]re in a sheet[ô]s class module, unqualified Range will refer to that sheet.
inputTemplateContent is a variable that contains a reference to a range, probably a named range. If you look at the RefersTo property of that named range, it likely points to a sheet other than the Activesheet at the time the code executes.
The best way to fix this is to avoid unqualified Range references by specifying the sheet. Like
Adjust the workbook and worksheet references to fit your particular situation.
=================================================================================
[][ô]s,
Tunusat.
Veja isso:
=================================================================================
http://stackoverflow.com/questions/12174723/run-time-error-1004-method-range-of-object-global-failed
Run-time error [ô]1004[ô] : Method [ô]Range[ô] of object[ô]_Global[ô] failed
When you reference Range like that it[ô]s called an unqualified reference because you don[ô]t specifically say which sheet the range is on. Unqualified references are handled by the [Ô]_Global[Ô] object that determines which object you[ô]re referring to and that depends on where your code is.
If you[ô]re in a standard module, unqualified Range will refer to Activesheet. If you[ô]re in a sheet[ô]s class module, unqualified Range will refer to that sheet.
inputTemplateContent is a variable that contains a reference to a range, probably a named range. If you look at the RefersTo property of that named range, it likely points to a sheet other than the Activesheet at the time the code executes.
The best way to fix this is to avoid unqualified Range references by specifying the sheet. Like
With ThisWorkbook.Worksheets([Ô]Template[Ô])
.Range(inputTemplateHeader).Value = NO_ENTRY
.Range(inputTemplateContent).Value = NO_ENTRY
End WithAdjust the workbook and worksheet references to fit your particular situation.
=================================================================================
[][ô]s,
Tunusat.
FFABIOG,
Apenas como sugestão, não seria melhor gerar um arquivo do tipo CSV?
Estes arquivos são associados diretamente ao Excel por padrão e seu código não precisaria [Ô]setar[Ô] o aplicativo Excel, seria basicamente o mesmo cuidado que você teria para gerar um TXT, mantendo, é claro, o padrão de dados do CSV separado por ponto e virgula.
Acho que seria algo mais ou menos assim:
Dim TextoLinha As String
Dim iArq As Long
iArq = FreeFile
Open Diretorio & [Ô]\NOME_ARQUIVO.csv[Ô] For Output As iArq
rs.Open [Ô]select DATA_V, FOR from CAD_CP where 1=1 [Ô] & FILTRO & [Ô]order by cod asc[Ô], db, 3, 3
While Not rs.EOF
TextoLinha = [Ô][Ô][Ô][Ô] & rs(0) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(1) & [Ô][Ô][Ô][Ô]
Print #iArq, TextoLinha
rs.MoveNext
Wend
Close #iArq
Set rs = Nothing
db.Close: Set db = Nothing
Nota: talvez seja necessário alguns ajustes no código... sempre me perco no uso das aspas... paciência ai... rsrsrs
Apenas como sugestão, não seria melhor gerar um arquivo do tipo CSV?
Estes arquivos são associados diretamente ao Excel por padrão e seu código não precisaria [Ô]setar[Ô] o aplicativo Excel, seria basicamente o mesmo cuidado que você teria para gerar um TXT, mantendo, é claro, o padrão de dados do CSV separado por ponto e virgula.
Acho que seria algo mais ou menos assim:
Dim TextoLinha As String
Dim iArq As Long
iArq = FreeFile
Open Diretorio & [Ô]\NOME_ARQUIVO.csv[Ô] For Output As iArq
rs.Open [Ô]select DATA_V, FOR from CAD_CP where 1=1 [Ô] & FILTRO & [Ô]order by cod asc[Ô], db, 3, 3
While Not rs.EOF
TextoLinha = [Ô][Ô][Ô][Ô] & rs(0) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(1) & [Ô][Ô][Ô][Ô]
Print #iArq, TextoLinha
rs.MoveNext
Wend
Close #iArq
Set rs = Nothing
db.Close: Set db = Nothing
Nota: talvez seja necessário alguns ajustes no código... sempre me perco no uso das aspas... paciência ai... rsrsrs
CHDSSANTOS
Está gerando erro ao abrir o caminho do csv
Está gerando erro ao abrir o caminho do csv
FFABIOG,
Desculpe, não informei que na linha:
Open Diretorio & [Ô]\NOME_ARQUIVO.csv[Ô] For Output As iArq
a palavra [Ô]Diretorio[Ô] é uma string que deve receber o caminho de onde salvar o arquivo.
Fiz uma simulação aqui e funcionou normal, segue meu código... adapta para vc e tenta de novo:
---------------------------------------------------------------------------------------------------------------------------------------
Dim TextoLinha As String
Dim iArq As Long
iArq = FreeFile
SQL = [Ô]SELECT dataregistro, horaregistro FROM Tbl1[Ô]
ExecutaComandoSQL [ô]sub de execução da instrução SQL
Open Environ([Ô]UserProFile[Ô]) & [Ô]\Desktop\NOME_ARQUIVO.csv[Ô] For Output As iArq
While Not rs.EOF
TextoLinha = [Ô][Ô][Ô][Ô] & rs(0) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(1) & [Ô][Ô][Ô][Ô]
Print #iArq, TextoLinha
rs.MoveNext
Wend
Close #iArq
FechaBanco [ô]sub para fechar a conexão
---------------------------------------------------------------------------------------------------------------------------------------
Desculpe, não informei que na linha:
Open Diretorio & [Ô]\NOME_ARQUIVO.csv[Ô] For Output As iArq
a palavra [Ô]Diretorio[Ô] é uma string que deve receber o caminho de onde salvar o arquivo.
Fiz uma simulação aqui e funcionou normal, segue meu código... adapta para vc e tenta de novo:
---------------------------------------------------------------------------------------------------------------------------------------
Dim TextoLinha As String
Dim iArq As Long
iArq = FreeFile
SQL = [Ô]SELECT dataregistro, horaregistro FROM Tbl1[Ô]
ExecutaComandoSQL [ô]sub de execução da instrução SQL
Open Environ([Ô]UserProFile[Ô]) & [Ô]\Desktop\NOME_ARQUIVO.csv[Ô] For Output As iArq
While Not rs.EOF
TextoLinha = [Ô][Ô][Ô][Ô] & rs(0) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(1) & [Ô][Ô][Ô][Ô]
Print #iArq, TextoLinha
rs.MoveNext
Wend
Close #iArq
FechaBanco [ô]sub para fechar a conexão
---------------------------------------------------------------------------------------------------------------------------------------
CHDSSANTOS
Adaptei o seu código ao meu e funcionou perfeitamente.
O bom seria mesmo exportar para o Excel, assim poderei fazer algumas formatações.
Eu consigo fazer essa mesma exportação só que para o Excel?
Se não for possÃvel, como fazer algumas formatações, tais como: nome do fornecedor, nº do pedido....
Quero deixar nas primeiras linhas essas informações
Segue o código
If Me.txt_data_I.Text <> [Ô][Ô] Then
If Not IsDate(Me.txt_data_I.Text) Then
MsgBox [Ô]Data de inicial inválida.[Ô], vbCritical, [Ô]ATENÇÃO[Ô]
Me.txt_data_I.Text = [Ô][Ô]
Me.txt_data_I.SetFocus
Exit Sub
End If
End If
If Me.txt_data_F.Text <> [Ô][Ô] Then
If Not IsDate(Me.txt_data_F.Text) Then
MsgBox [Ô]Data de final inválida.[Ô], vbCritical, [Ô]ATENÇÃO[Ô]
Me.txt_data_F.Text = [Ô][Ô]
Me.txt_data_F.SetFocus
Exit Sub
End If
End If
Dim FILTRO As String
Dim Item As ListItem
Me.lbl_lista.ListItems.Clear
connectdb
If Me.opt_ven.value = True Then
If txt_data_I.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô] and DATA_V >= #[Ô] & Format(Me.txt_data_I.Text, [Ô]mm/dd/yyyy[Ô]) & [Ô]#[Ô]
End If
If txt_data_F.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô] and DATA_V <= #[Ô] & Format(Me.txt_data_F.Text, [Ô]mm/dd/yyyy[Ô]) & [Ô]#[Ô]
End If
Else
If txt_data_I.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô] and DATA_PGTO >= #[Ô] & Format(Me.txt_data_I.Text, [Ô]mm/dd/yyyy[Ô]) & [Ô]#[Ô]
End If
If txt_data_F.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô] and DATA_PGTO <= #[Ô] & Format(Me.txt_data_F.Text, [Ô]mm/dd/yyyy[Ô]) & [Ô]#[Ô]
End If
End If
If cbc_cli.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô]and CLI = [ô][Ô] & cbc_cli.Text & [Ô][ô][Ô]
End If
If Me.opt_nao_pg.value = True Then
FILTRO = FILTRO & [Ô] and BAN IS NULL or BAN=[ô][ô][Ô]
End If
If Me.opt_pago.value = True Then
FILTRO = FILTRO & [Ô] and BAN<>[ô][ô][Ô]
End If
If Me.opt_ven.value = True Then
rs.Open [Ô]select * from CAD_CR WHERE 1=1 [Ô] & FILTRO & [Ô]order by DATA_V asc,cod asc[Ô], db, 3, 3
Else
rs.Open [Ô]select * from CAD_CR WHERE 1=1 [Ô] & FILTRO & [Ô]order by DATA_PGTO asc,cod asc[Ô], db, 3, 3
End If
[ô] EXPORTAÇÃO PARA O EXCEL
Dim TextoLinha As String
Dim iArq As Long
iArq = FreeFile
Open Environ([Ô]UserProFile[Ô]) & [Ô]\Desktop\pedido.csv[Ô] For Output As iArq
While Not rs.EOF
TextoLinha = [Ô][Ô][Ô][Ô] & rs(0) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(3) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(4) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(5) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(7) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(8) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(11) & [Ô][Ô][Ô][Ô]
Print #iArq, TextoLinha
rs.MoveNext
Wend
Close #iArq
Set rs = Nothing
db.Close: Set db = Nothing
Adaptei o seu código ao meu e funcionou perfeitamente.
O bom seria mesmo exportar para o Excel, assim poderei fazer algumas formatações.
Eu consigo fazer essa mesma exportação só que para o Excel?
Se não for possÃvel, como fazer algumas formatações, tais como: nome do fornecedor, nº do pedido....
Quero deixar nas primeiras linhas essas informações
Segue o código
If Me.txt_data_I.Text <> [Ô][Ô] Then
If Not IsDate(Me.txt_data_I.Text) Then
MsgBox [Ô]Data de inicial inválida.[Ô], vbCritical, [Ô]ATENÇÃO[Ô]
Me.txt_data_I.Text = [Ô][Ô]
Me.txt_data_I.SetFocus
Exit Sub
End If
End If
If Me.txt_data_F.Text <> [Ô][Ô] Then
If Not IsDate(Me.txt_data_F.Text) Then
MsgBox [Ô]Data de final inválida.[Ô], vbCritical, [Ô]ATENÇÃO[Ô]
Me.txt_data_F.Text = [Ô][Ô]
Me.txt_data_F.SetFocus
Exit Sub
End If
End If
Dim FILTRO As String
Dim Item As ListItem
Me.lbl_lista.ListItems.Clear
connectdb
If Me.opt_ven.value = True Then
If txt_data_I.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô] and DATA_V >= #[Ô] & Format(Me.txt_data_I.Text, [Ô]mm/dd/yyyy[Ô]) & [Ô]#[Ô]
End If
If txt_data_F.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô] and DATA_V <= #[Ô] & Format(Me.txt_data_F.Text, [Ô]mm/dd/yyyy[Ô]) & [Ô]#[Ô]
End If
Else
If txt_data_I.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô] and DATA_PGTO >= #[Ô] & Format(Me.txt_data_I.Text, [Ô]mm/dd/yyyy[Ô]) & [Ô]#[Ô]
End If
If txt_data_F.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô] and DATA_PGTO <= #[Ô] & Format(Me.txt_data_F.Text, [Ô]mm/dd/yyyy[Ô]) & [Ô]#[Ô]
End If
End If
If cbc_cli.Text <> [Ô][Ô] Then
FILTRO = FILTRO & [Ô]and CLI = [ô][Ô] & cbc_cli.Text & [Ô][ô][Ô]
End If
If Me.opt_nao_pg.value = True Then
FILTRO = FILTRO & [Ô] and BAN IS NULL or BAN=[ô][ô][Ô]
End If
If Me.opt_pago.value = True Then
FILTRO = FILTRO & [Ô] and BAN<>[ô][ô][Ô]
End If
If Me.opt_ven.value = True Then
rs.Open [Ô]select * from CAD_CR WHERE 1=1 [Ô] & FILTRO & [Ô]order by DATA_V asc,cod asc[Ô], db, 3, 3
Else
rs.Open [Ô]select * from CAD_CR WHERE 1=1 [Ô] & FILTRO & [Ô]order by DATA_PGTO asc,cod asc[Ô], db, 3, 3
End If
[ô] EXPORTAÇÃO PARA O EXCEL
Dim TextoLinha As String
Dim iArq As Long
iArq = FreeFile
Open Environ([Ô]UserProFile[Ô]) & [Ô]\Desktop\pedido.csv[Ô] For Output As iArq
While Not rs.EOF
TextoLinha = [Ô][Ô][Ô][Ô] & rs(0) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(3) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(4) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(5) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(7) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(8) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(11) & [Ô][Ô][Ô][Ô]
Print #iArq, TextoLinha
rs.MoveNext
Wend
Close #iArq
Set rs = Nothing
db.Close: Set db = Nothing
Cara,
Muitos destes problemas com o Excel ocorrem pelo fato de que o VB não fecha o Excel completamente.
Tem muitos anos que eu não trabalho mais com VB6, mas a lógica é esta:
1. Antes de abrir o Excel, o programa faz um loop entre os processos em segundo plano da máquina;
2. Caso encontrasse algum arquivo com proccessName igual a Excel, entra no loop;
3. Se a janela principal deste processo estiver vazia, então Kill() o processo. (Obs. Se o processo estiver com sua janela principal vazia, significa que este processo você pode deletar porque é um processo do seu próprio programa).
Você pode fazer o teste e abrir um arquivo Excel, deixá-lo aberto e rodar o seu programa. Você verá que o seu programa não vai fechar o arquivo Excel porque quando você abre um arquivo Excel, ele é aberto com um nome qualquer, tipo [Ô]Pasta1[Ô], [Ô]Pasta1 - Microsoft Excel[Ô], etc.
Espero ter ajudado.
Muitos destes problemas com o Excel ocorrem pelo fato de que o VB não fecha o Excel completamente.
Tem muitos anos que eu não trabalho mais com VB6, mas a lógica é esta:
1. Antes de abrir o Excel, o programa faz um loop entre os processos em segundo plano da máquina;
2. Caso encontrasse algum arquivo com proccessName igual a Excel, entra no loop;
3. Se a janela principal deste processo estiver vazia, então Kill() o processo. (Obs. Se o processo estiver com sua janela principal vazia, significa que este processo você pode deletar porque é um processo do seu próprio programa).
Você pode fazer o teste e abrir um arquivo Excel, deixá-lo aberto e rodar o seu programa. Você verá que o seu programa não vai fechar o arquivo Excel porque quando você abre um arquivo Excel, ele é aberto com um nome qualquer, tipo [Ô]Pasta1[Ô], [Ô]Pasta1 - Microsoft Excel[Ô], etc.
Espero ter ajudado.
FFABIOG,
Acredito que neste formato até seja possÃvel salvar o arquivo com a extensão *.xls e em vez de separar as informações por ponto e virgula separar por tabulação (vbtab), mas nunca fiz isso e não posso te afirmar que funcionaria e o quanto isso seria confiável.
Para colocar o cabeçalho de uma maneira simples você pode apenas replicar a linha que roda no while com os nomes de cada campo antes de entrar no loop.
Open Environ([Ô]UserProFile[Ô]) & [Ô]\Desktop\pedido.csv[Ô] For Output As iArq
TextoLinha = [Ô][Ô][Ô][Ô] & [Ô]Coluna 0[Ô] & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & [Ô]Coluna 3[Ô] & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & [Ô]Coluna 4[Ô] & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & [Ô]Coluna 5[Ô] & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & [Ô]Coluna 7[Ô] & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & [Ô]Coluna 8[Ô] & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & [Ô]Coluna 11[Ô] & [Ô][Ô][Ô][Ô]
Print #iArq, TextoLinha
While Not rs.EOF
TextoLinha = [Ô][Ô][Ô][Ô] & rs(0) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(3) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(4) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(5) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(7) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(8) & [Ô][Ô][Ô][Ô] & [Ô];[Ô][Ô][Ô] & rs(11) & [Ô][Ô][Ô][Ô]
Print #iArq, TextoLinha
rs.MoveNext
Wend
Close #iArq
Tópico encerrado , respostas não são mais permitidas