Notifications
Clear all

Alterar Intervalo de Consulta Query Excel VBA

14 Posts
2 Usuários
0 Reactions
3,472 Visualizações
(@lcsimao)
Posts: 20
Eminent Member
Topic starter
 

Primeiramente, boa tarde a todos do Planilhando. Quero agradecer pela iniciativa de todos em auxiliar todos aqueles que tentam de uma forma e de outra e acabam travando no caminho. Sempre tirei minhas dúvidas sobre como proceder através das dúvidas de outros. Mas desta travei também.

Estou utilizando um Fórum já resolvido para fazer algo parecido onde trabalho, mas não consigo acertar os erros:

Estou tentando o seguinte:

Private Sub btGerarReceber_Click()
Data1 = Format(Me!txtDataIni.Text, "yyy-mm-dd")
Data2 = Format(Me!txtDataFim.Text, "yyyy-mm-dd")
Sheets("Plan2").Select
Columns("A:c").Select
Selection.ListObject.QueryTable.Delete
Selection.ClearContents
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Banco;Driver=Firebird/InterBase(r) driver;Dbname=CAMINHO;CHARSET=NONE;UID=SYSDBA;Client=C:Program Files (x86)FirebirdFirebird_2_0binfbclient.dll;")), Destination:=Range("$A$1")).QueryTable

.CommandText = Array("SELECT CTASRECPAG.LOCALCOB, CTASRECPAG.DATAPRORROGACAO, CTASRECPAG.HISTORICO, CTASRECPAG.IDEMPRESA, CTASRECPAG.IDCCUSTO, CTASRECPAG.IDCONTA, CTASRECPAG.NUMDOC_EMPRESA, CTASRECPAG.NUMDOC_CLIFORNE, CTASRECPAG.VALOR FROM CTASRECPAG CTASRECPAG WHERE (CTASRECPAG.LOCALCOB<>64) AND (CTASRECPAG.DATAPRORROGACAO>= '" & Data1 & "') AND (CTASRECPAG.DATAPRORROGACAO<= '" & Data2 & ") AND (CTASRECPAG.ST='A') AND (CTASRECPAG.TIPOMOVFINAN='06')")

.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Tabela_ConsultaPeriodoReceber"
.Refresh BackgroundQuery:=False
End With
frmContasReceber.Hide
Columns("b:b").Select
Selection.NumberFormat = "dd/mm/yyyy"
Columns("c:c").ColumnWidth = 13.43
Columns("c:c").Select
Selection.Style = "Comma"
End Sub

Tirei quase a totalidade das linhas acima do fórum " Alterar Intervalo Consulta Query Excel VBA" e tentei adaptar, mas sem sucesso.

Minha dificuldade começa na segunda linha. Dá um erro de execução 438 e informa que o objeto não aceita a propriedade ou método.

Fico muito agradecido pela ajuda.

Grato,

 
Postado : 29/05/2013 1:00 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Como disse no tópico referenciado, não posso testar pois não tenho e não me utilizo do Firebird.
Qto ao erro a que se refere, tente conforme abaixo e veja evolui mais o codigo:
Altere :
Sheets("Plan2").Select
Columns("A:c").Select
Para:
Sheets("Plan2").Columns("A:C").Select

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 29/05/2013 1:38 pm
(@lcsimao)
Posts: 20
Eminent Member
Topic starter
 

Bom dia Reinaldo,

Obrigado pelo retorno.

Quando eu clico no botão "btGerarReceber" para iniciar a macro, aparece a janela do erro, onde clico para depurar ficando a linha " Data1 = Format(Me!txtDataIni.Text, "yyy-mm-dd")" marcada de amarelo, me fazendo entender que o erro está nesta linha....

Estou me perguntando se a forma de inserir a data está correto, pois o que fiz foi adicionar na planilha dois TxtBox, nomeá-los com o nome de TxtDataini e o outro com TxtDataFim e já coloquei ali as datas de várias maneiras diferentes-Data Base: 01 de maio de 2013- (Ex:20130501, 01052013, 05012013, com "/" e "-") conforme o link que você havia disponibilizado no outro fórum ( http://comunidade.itlab.com.br/eve/foru ... 2091015312), mas a macro não passa dessa linha.

Não precisa declarar a variável "Data1" talvez?

Com relação a alteração que sugeriu, já fiz...mas ainda não dá pra testar devido ao erro.

Fico grato,

 
Postado : 31/05/2013 7:19 am
(@lcsimao)
Posts: 20
Eminent Member
Topic starter
 

Reinaldo,

Na mensagem que te enviei o formato da data está "yyy-mm-dd", deletei sem querer um dos "y", mas na macro está correto "yyyy-mm-dd".

Grato,

Leonardo Simão

 
Postado : 31/05/2013 8:10 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Leonardo, o código disponibilizado subentende que existe um formulário e nesse um campo denominado txtDataIni, se não existir gerara erro (Erro 438) logo no inicio

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 31/05/2013 8:31 am
(@lcsimao)
Posts: 20
Eminent Member
Topic starter
 

Bom dia Reinando,

O formulário, está resumido nestes dois TextBox's, que estão inseridos na planilha - TxtDataIni e TxtDataFim. Não são suficientes?

Fico grato,

Leonardo Simão

 
Postado : 31/05/2013 9:07 am
(@lcsimao)
Posts: 20
Eminent Member
Topic starter
 

Bom dia Reinaldo,

Estou tomando como base uma planilha que trabalhei certa vez que usava o mesmo critério, ou seja, dois textbox...abaixo, envio os códigos que usava anteriormente para que você entenda o que quero fazer...só que agora com a conexão ao banco de dados pelo firebird....

Private Sub CommandButton1_Click()
' Cria a conexão.
Dim cnPubs As ADODB.Connection
Set cnPubs = New ADODB.Connection ' Variável para armazenar a String de Conexão.
Dim strConn As String
Dim strSQL As String

'Informa o SQL Server OLE DB Provider.
strConn = "PROVIDER=SQLOLEDB;DATA SOURCE=CAMINHO;INITIAL CATALOG=NOME;User ID=NOME;Password=SENHA"

Plan3.Range("L9:O999999").ClearContents

'Abre a conexão.
cnPubs.Open strConn

' Cria o objeto Recordset.
Dim rsPubs As ADODB.Recordset
Set rsPubs = New ADODB.Recordset

With rsPubs
' Associa a conexão.
.ActiveConnection = cnPubs

' Extrai os dados.
strSQL = " select data_abert, count(os_num_cliente) as QTD_ABE, 'MG' as UF " & _
" into #temp_abert from SITEC..tb_os where os_data_abert >= '" + dtIni.Text + "' and os_data_abert <= '" + dtFim.Text + "'" & _
"and ser_codigo <> 7 group by os_data_abert order by 1" & _
" select os_data_conc, count(os_num_cliente) as QTD_CON, 'MG' as UF " & _

....E AÍ VAI SEGUINDO O CÓDIGO.....

cnPubs.Execute strSQL, lngRecsAff, adExecuteNoRecords
Debug.Print "Records affected: " & lngRecsAff
.Open " select isnull(os_data_abert, os_data_conc), QTD_ABE, " + edtCap.Text + ", QTD_CON " & _
" from #temp_abert left join #temp_conc on os_data_abert = os_data_conc " & _
" and #temp_conc.UF = #temp_abert.UF where #temp_conc.UF= '" + edtUF.Text + "'"

' Coloca os dados na planilha.
Plan3.Range("L9").CopyFromRecordset rsPubs

' Fecha a transação
.Close
End With

' Fecha conexão
cnPubs.Close
Set rsPubs = Nothing
Set cnPubs = Nothing

End Sub

 
Postado : 03/06/2013 8:05 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia Reinando,

O formulário, está resumido nestes dois TextBox's, que estão inseridos na planilha - TxtDataIni e TxtDataFim. Não são suficientes?

Fico grato,

Leonardo Simão

Leonardo, a principio se você não tiver no VBA a expressão Option Explicit não precisa fazer a declaração, mas se tiver tem de declarar.

Mas oque não ficou claro para mim é que tipo de controle Txt está usando, primeiro deu a entender que é atraves de um Formulario (UserForm) criado na tela do VBA, mas conforme você diz aqui e no post acima :" pois o que fiz foi adicionar na planilha dois TxtBox, nomeá-los com o nome de TxtDataini e o outro com TxtDataFim" fiquei confuso, se os mesmos estiverem na planilha, não utilizamos "Format(Me!txtDataIni" que estariamos nos referindo ao controle no proprio form.

Se o controle está na planilha você tem de indicar, tipo :
Data1 = Worksheets("MinhaPlanilha").txtDataIni.Value

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 03/06/2013 9:03 am
(@lcsimao)
Posts: 20
Eminent Member
Topic starter
 

Bom dia Senhores,

É isso mesmo!!...até já alterei a linha e desta parte passamos, na planilha, célula A1 aparece a informação "DadosExternos_1: Obtendo dados ..." mas fica nisto, ainda não carrega as informações. Como só preciso que a informação seja relacionada a partir da Célula A1 como uma tabela, diminui o código ficando assim:

Private Sub btGerarReceber_Click()

Data1 = Worksheets("Parametros").txtDataIni.Value
Data1 = Worksheets("Parametros").txtDataFim.Value

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Dogclean2;Driver=Firebird/InterBase(r) driver;Dbname=192.168.1.25:Albatroz_Dogclean; CHARSET=NONE;UID=SYSDBA;Client=C:Program Files " & _
"(x86)FirebirdFirebird_2_0binfbclient.dll;")), Destination:=Range("$A$1")).QueryTable

.CommandText = Array("SELECT CTASRECPAG.LOCALCOB, CTASRECPAG.DATAPRORROGACAO, CTASRECPAG.HISTORICO, CTASRECPAG.IDEMPRESA, CTASRECPAG.IDCCUSTO, CTASRECPAG.IDCONTA, CTASRECPAG.NUMDOC_EMPRESA, CTASRECPAG.NUMDOC_CLIFORNE, CTASRECPAG.VALOR FROM CTASRECPAG CTASRECPAG WHERE (CTASRECPAG.LOCALCOB<>64) AND (CTASRECPAG.DATAPRORROGACAO>= '" & Data1 & "') AND (CTASRECPAG.DATAPRORROGACAO<= '" & Data2 & ") AND (CTASRECPAG.ST='A') AND (CTASRECPAG.TIPOMOVFINAN='06')")

End With

End Sub

Agora o erro acontece na linha ".commandText = ..." erro 13, tipos incompatíveis... tem algo que eu posso acrescentar para que resolva esta incompatibilidade? Acho que só falta isso...

Fico muito grato,

Leonardo Simão

 
Postado : 05/06/2013 7:53 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Leonardo, o erro siginifica que alguns dos valores que estão sendo buscado não são dos mesmos tipos, por exemplo se definiu uma variavel como sendo Integer e no local é um texto teremos incompatibilidade, verifique como estão as declarações de tipos.

De uma olhada abaixo sobre Tipos de Variáveis

http://www.juliobattisti.com.br/cursos/ ... lo5/14.asp

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 05/06/2013 11:35 am
(@lcsimao)
Posts: 20
Eminent Member
Topic starter
 

Boa tarde Senhores,

Estou de volta... como sugeriu verifiquei as funções de tipos, mas não consegui adequá-las ao problema. Para saber se alguma coisa estava funcionando, fiz assim...acrescentei todas os campos dos quais precisa sem critério algum e as informações foram carregadas com sucesso para a planilha, acrescentei então um critério como por exemplo " Where (CTASRECPAG.ST='A') e também funcionou...e tentei outros e percebi que sempre individualmente funciona...mas ao tentar incluir mais um critério com o "AND" aí não vai...por mais que os campos tenham dados como "DATA" por exemplo, ou seja, o mesmo tipo de informação.

Fico muito agradecido pela informação.

Leonardo Simão

 
Postado : 10/06/2013 12:23 pm
(@lcsimao)
Posts: 20
Eminent Member
Topic starter
 

Boa Tarde Senhores,

Passei uma informação equivocada...depois de trabalhar em cima do código, ele está assim:

Private Sub btGerarReceber_Click()

Sheets("Parametros").Select
Columns("A:H").Select
Selection.ListObject.QueryTable.Delete
Selection.ClearContents
Range("A1").Select

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Banco;Driver=Firebird/InterBase(r) driver;Dbname=CAMINHO;CHARSET=NONE;UID=SYSDBA;Client=C:Program Files (x86)FirebirdFirebird_2_0binfbclient.dll;")), Destination:=Range("$A$1")).QueryTable

.CommandText = Array("SELECT CTASRECPAG.VALOR, CTASRECPAG.DATAPRORROGACAO FROM CTASRECPAG WHERE CTASRECPAG.DATAPRORROGACAO>='" + DataIni.Text + "'AND " & _
" CTASRECPAG.DATAPRORROGACAO<='" + DataFim.Text + "'AND (CTASRECPAG.ST='A') AND (CTASRECPAG.TIPOMOVFINAN='06')AND (CTASRECPAG.LOCALCOB<>'64')")

'.RowNumbers = False
'.FillAdjacentFormulas = False
.PreserveFormatting = True
'.RefreshOnFileOpen = False
.BackgroundQuery = True
'.RefreshStyle = xlInsertDeleteCells
'.SavePassword = False
'.SaveData = True
'.AdjustColumnWidth = False
'.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False

End With

End Sub

Como podem ver, primeiramente, como havia dito logo acima, inseri todos os campos que precisava com apenas um critério e funcionou, mas ao tentar incluir mais um, o erro voltava. Desfiz o que tinha feito, ou seja, tirei todos os campos, deixando apenas um e agora trabalhei em cima somente dos critérios, adicionei todos que precisava. Comecei a adicionar os campos e no primeiro funcionou, fiquei com dois campos e todos os critérios, mas ao tentar adicionar um terceiro o erro volta...parece mais um limite de informações!

...Do jeito que está aí em cima, funciona, mas somente com dois campos...os critérios de que preciso não acometeu qualquer erro. As duas colunas ou campos que são listados no excel são referente a valores e datas, mas funciona...
Acredito que deva haver alguma forma de burlar este erro para inserir outras colunas...

Fico imensamente agradecido...

Leonardo Simão

 
Postado : 10/06/2013 1:25 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Leonardo, não sou expert em SQL, mas a principio o operador AND ´pode ter mais de duas condições como pode ver no link abaixo :
SQL: "AND" Condition
The SQL "AND" condition allows you to create an SQL statement based on 2 or more conditions being met. It can be used in any valid SQL statement
http://www.techonthenet.com/sql/and.php

Neste temos mais algumas informações :
http://www.w3schools.com/sql/sql_and_or.asp

Pode até ser que como o Firebird tenha alguma limitação, mas acredito que é questão mais das variaveis, mas só testando para saber, sem um exemplo pratico ficaremos na suposição.

No Link abaixo apesar de terem colocado se foi resolvido tem uma questão sobre o Operador :
why can i use 3 conditions in SQL statement only?
http://www.excelforum.com/excel-program ... -only.html

Veja se alguns destes links ajudam.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/06/2013 3:14 pm
(@lcsimao)
Posts: 20
Eminent Member
Topic starter
 

Boa tarde Pessoal,

Quero agradecer pela ajuda de vocês... Ficou resolvido o problema...Nas pesquisas que fiz, descobri que podemos fazer a macro da conexão e foi o que fiz...quando terminei, peguei a parte do ".commandText" e colei na planilha que estava fazendo, sem muitas alterações. Pelo que percebi o problema era a forma como estava escrevendo...ficou então da seguinte forma para termos aí mais um canal que outras pessoas possam aproveitar para fazer seus projetos:

Private Sub btGerarReceber_Click()

Sheets("Parametros").Select
Columns("A:N").Select
Selection.ListObject.QueryTable.Delete
Selection.ClearContents

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=BANCO;Driver=Firebird/InterBase(r) driver;Dbname=CAMINHO; CHARSET=NONE;UID=SYSDBA;Client=C:Program Files " & _
"(x86)FirebirdFirebird_2_0binfbclient.dll;")), Destination:=Range("$E$7")).QueryTable

.CommandText = Array( _
"SELECT CTASRECPAG.LOCALCOB, CTASRECPAG.DATAEMISSAO, CTASRECPAG.DATAPRORROGACAO, CTASRECPAG.HISTORICO, CTASRECPAG.ID" _
, _
"EMPRESA, CTASRECPAG.IDCCUSTO, CTASRECPAG.IDCONTA, CTASRECPAG.NUMDOC_EMPRESA, CTASRECPAG.NUMDOC_CLIFORNE, CTASRECPAG" _
, _
".VALOR FROM CTASRECPAG CTASRECPAG WHERE (CTASRECPAG.LOCALCOB<>64) AND (CTASRECPAG.DATAPRORROGACAO>='" + DataIni + "'" _
, _
"And CTASRECPAG.DATAPRORROGACAO<='" + DataFim.Text + "') AND (CTASRECPAG.ST='A') AND (CTASREC" _
, "PAG.TIPOMOVFINAN='06') ORDER BY CTASRECPAG.DATAPRORROGACAO")

'.RowNumbers = False
'.FillAdjacentFormulas = False
.PreserveFormatting = True
'.RefreshOnFileOpen = False
.BackgroundQuery = True
'.RefreshStyle = xlInsertDeleteCells
'.SavePassword = False
'.SaveData = True
'.AdjustColumnWidth = False
'.RefreshPeriod = 0
.PreserveColumnInfo = True
'.Refresh BackgroundQuery:=False
ActiveWorkbook.RefreshAll

End With

Columns("g:g").Select
Selection.NumberFormat = "dd/mm/yyyy"

End Sub

 
Postado : 11/06/2013 12:53 pm