Onde esta o Erro?

[JCORTEZ 0]

Pessoal,

estou montando um form para fazer a carga de um arquivo texto em um bd acess2000,onde o usuario informará o caminho/nome do arquivo a ser carregado e o caminho/nome do bd onde será criada a tabela e feita tb a carga do arquivo , que vira com os campos separados por ponto-e-vigula, após isto o usuario clicará num botão para fazer a ação de crga, ta tudo funcionando ( ou quase!) porém quando rodo o form ele cria a tabela mas NÃO insere os dados, alguem poderia dar uma olhada no código e dar uma luz , de onde estou errando ??

 

Agradeço a ajuda Pessoal http://forum.imasters.com.br/public/style_emoticons/default/clap.gif

 

ai vai o código

Sub ParseToArray(sLine As String, A() As String) Dim P As Long, LastPos As Long, I As Long' InStr é retornar a posição do caractere de busca na cadeia' de caracteres de origem  P = InStr(sLine, ";") Do While P   A(I) = Mid$(sLine, LastPos + 1, P - LastPos - 1)   LastPos = P   I = I + 1   P = InStr(LastPos + 1, sLine, ";", vbBinaryCompare) Loop   A(I) = Mid$(sLine, LastPos + 1)End SubPrivate Sub Command1_Click() Dim F As Long, sLine As String, A(0 To 2) As String Dim db As New ADODB.Connection, rs As Recordset On Error GoTo trata_erro  db.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _"Data Source=C:\Teste\biblio.mdb;" db.Open ' Abre arquivo Txt F = FreeFile Open TxtNomArq.Text For Input As F' Set db = DBEngine(0).OpenDatabase(Text2.Text) On Error Resume Next' Verifica se a tabela ja existe db.Execute "DROP TABLE ImportaTexto"' Cria a estrutura da Tabela db.Execute "CREATE TABLE ImportaTexto (CODIGO LONG, [Desc] TEXT (50), " _& "Valor CURRENCY )"  With rs   .ActiveConnection = db   .CursorLocation = adUseClient   .CursorType = adOpenStatic   .LockType = adLockBatchOptimistic           .Open ("select * from ImportaTexto")   .ActiveConnection = Nothing End With        If rs.RecordCount < 1 Then    Dim Cria As String    Do While Not EOF(F)       Line Input #F, sLine       ParseToArray sLine, A()      'Insere dados na Tabela Importa Texto       Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values('" _       & Val(A(0)) & "'," & A(1) & ",'" & Val(A(2)) & "')"       db.Execute Cria     Loop     MsgBox "Arquivo texto importado com sucesso !! "     rs.Close     db.Close     Close #F  End If Exit Subtrata_erro:    MsgBox "Ocorreu o erro ==> " & Err.DescriptionEnd SubPrivate Sub Command2_Click() EndEnd Sub

[Graymalkin 0]

Experimente tirar o...

 

.ActiveConnection = Nothing

... e veja se dá certo. Se também não der, experimente então abrir o recordset requisitando a quantidade de registros via SQL ("SELECT Count(*) AS quantidade FROM tabela;"). O RecordCount não funciona em alguns casos.

 

Abraços,

 

Graymalkin

[JCORTEZ 0]

:( , que pena Graymalkin .... não funcionou.... mais alguma sugestão, kca to ficando doido :blink: com este código.............

To aceitando novas sugestões

 

por enquanto vlw

 

http://forum.imasters.com.br/public/style_emoticons/default/joia.gif

[Graymalkin 0]

:(   , que pena Graymalkin .... não funcionou.... mais alguma sugestão, kca to ficando doido  :blink:   com este código.............

Como você fez? Posta o código aqui pra eu dar uma olhada.Abraços,Graymalkin

[JCORTEZ 0]

ok amigo, bem eu como apoóstrofe para inibir a linha

' .ActiveConnection = nothing

e a sua sugestão do select ficou assim...

 

Sub ParseToArray(sLine As String, A() As String) Dim P As Long, LastPos As Long, I As Long' InStr é retornar a posição do caractere de busca na cadeia' de caracteres de origem  P = InStr(sLine, ";") Do While P   A(I) = Mid$(sLine, LastPos + 1, P - LastPos - 1)   LastPos = P   I = I + 1   P = InStr(LastPos + 1, sLine, ";", vbBinaryCompare) Loop   A(I) = Mid$(sLine, LastPos + 1)End SubPrivate Sub Command1_Click() Dim F As Long, sLine As String, A(0 To 2) As String Dim db As New ADODB.Connection, rs As Recordset On Error GoTo trata_erro  db.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _"Data Source=C:\Teste\biblio.mdb;" db.Open ' Abre arquivo Txt F = FreeFile Open TxtNomArq.Text For Input As F' Set db = DBEngine(0).OpenDatabase(Text2.Text) On Error Resume Next' Verifica se a tabela ja existe db.Execute "DROP TABLE ImportaTexto"' Cria a estrutura da Tabela db.Execute "CREATE TABLE ImportaTexto (CODIGO LONG, [Desc] TEXT (50), " _& "Valor CURRENCY )"  With rs   .ActiveConnection = db   .CursorLocation = adUseClient   .CursorType = adOpenStatic   .LockType = adLockBatchOptimistic          [COLOR=red] .Open ("select count(*) as CODIGO from ImportaTexto")[/COLOR]   .ActiveConnection = Nothing End With        If rs.RecordCount < 1 Then    Dim Cria As String    Do While Not EOF(F)       Line Input #F, sLine       ParseToArray sLine, A()      'Faz a insersão dos Dados       Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values('" _       & Val(A(0)) & "'," & A(1) & ",'" & Val(A(2)) & "')"       db.Execute Cria     Loop     MsgBox "Arquivo texto importado com sucesso !! "     rs.Close     db.Close     Close #F  End If Exit Subtrata_erro:    MsgBox "Ocorreu o erro ==> " & Err.DescriptionEnd SubPrivate Sub Command2_Click() EndEnd Sub

Porém ainda assim, criou a tabela , mas não inseriu os dados....

espero q voce consiga achar o erro.... BRIGADÃO http://forum.imasters.com.br/public/style_emoticons/default/thumbsup.gif

 

vlw

[JCORTEZ 0]

E aí pessoal, alguma luz no final do Tunel .... que não seja o trem ???ainda não consegui solucionar este problema :( vlw..

[Graymalkin 0]

A idéia seria essa daqui:

 

rs.Open "SELECT Count(*) AS quantidade FROM ImportaTexto", db, 2, 3     If rs.Fields("quantidade").Value < 1 Then   'bláblá

Creio que não tenha ficado muito claro quando eu falei da primeira vez.

 

Abraços,

 

Graymalkin

[JCORTEZ 0]

Graymalkin, desculpe , mas creio que quem não foi claro fui eu.... :) , pois o código funciona até o trecho em que faço o comando insert, verifiquei atraves do debug, que mesmo durante o comando os campos trazem conteúdo... o codigo execura o comando "db.execute cria" sem qualquer problema , porém quando olho no banco access, não foi incluido nenhum registro......acho que esta faltando algo...

Aí vai de novo o trecho em que faço o insert....por favor , ja abusando veja se consegue achar algo.. http://forum.imasters.com.br/public/style_emoticons/default/cry.gif

 

If rs.Fields(CODIGO).Value < 1 Then    Dim Cria As String    Do While Not EOF(F)       Line Input #F, sLine       ParseToArray sLine, A()      ' insere conteudo na tabela IMPORTATEXTO       Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values('" _       & Val(A(0)) & "'," & A(1) & ",'" & Val(A(2)) & "')"       db.Execute Cria     Loop     MsgBox "Arquivo texto importado com sucesso !! "     rs.Close     db.Close     Close #F  End If

Vlw Amigão..

[Graymalkin 0]

Graymalkin, desculpe , mas creio que quem não foi claro fui eu....  :) , pois o código funciona até o trecho em que faço o comando insert, verifiquei atraves do debug, que mesmo durante o comando os campos trazem conteúdo... o codigo execura o comando "db.execute cria"  sem qualquer problema , porém quando olho no banco access,  não foi incluido nenhum registro......acho que esta faltando algo...

  Aí vai de novo o trecho em que faço o insert....por favor , ja abusando veja se consegue achar algo.. http://forum.imasters.com.br/public/style_emoticons/default/cry.gif

 

If rs.Fields(CODIGO).Value < 1 Then    Dim Cria As String    Do While Not EOF(F)       Line Input #F, sLine       ParseToArray sLine, A()      ' insere conteudo na tabela IMPORTATEXTO       Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values('" _       & Val(A(0)) & "'," & A(1) & ",'" & Val(A(2)) & "')"       db.Execute Cria     Loop     MsgBox "Arquivo texto importado com sucesso !! "     rs.Close     db.Close     Close #F  End If

Vlw Amigão..

<{POST_SNAPBACK}>

Humm... já experimentou utilizar aquela opção de reparo do banco no Access? Realmente não parece ter erro algum. Experimente também tirar aquele On Error para ver se acusa algum.

 

Abraços,

 

Graymalkin

[JCORTEZ 0]

http://forum.imasters.com.br/public/style_emoticons/default/clap.gif

Desta vez você acertou Graymalkin, fiz a verificação do access (reparo) e tudo ok... depois retirei o "on error " e aí começou a dar erro na linha do

If rs.Fields(CODIGO).Value < 1 Then

, dai voltei para

"If rs.RecordCount = 1 Then...

Agora o erro é o seguinte "erro de sintaxe na instrução Insert Into." e o código esta assim neste trecho...

 

[/code]

If rs.RecordCount = 1 Then

Dim Cria As String

Do While Not EOF(F)

Line Input #F, sLine

ParseToArray sLine, A()

'Insere os registros na tabela ImportaTexto

Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values(" _

& Val(A(0)) & ",'" & A(1) & "'," & Val(A(2)) & ")"

db.Execute Cria

Loop

 

MsgBox "Arquivo texto importado com sucesso !! "

 

rs.Close

db.Close

 

Close #F

End If

 

que m... :angry: assim vou ficar louco...

help !!!!

[luiz humberto 0]

If rs.Fields(CODIGO).Value < 1 ThenIf rs.RecordCount = 1 Then...

Os dois trechos de código não fazem a mesma coisa, um retorna o valor no campo e outro indica a quantidade de registros retornado no RecordSet.Com relação ao erro da instrução Insert, execute passo a passo e verifique o que está sendo passado a ela.

Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values(" _& Val(A(0)) & ",'" & A(1) & "'," & Val(A(2)) & ")"Debug.Print Cria'Veja como esta sendo executada a instruçãodb.Execute Cria

[JCORTEZ 0]

Luiz, valeu a dica sobre "recordcount e Fields" edu ainda estou meio http://forum.imasters.com.br/public/style_emoticons/default/sick.gif no vb...

fiz a alteração que voce sugeriu (debug.print cria) e o que percebi é que o campo de valor esta sendo passado incorretamente..

 

Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values(" _& Val(A(0)) & ",'" & A(1) & "','" & Val(A(2)) & "')"Debug.Print Criadb.Execute Cria

o conteudo de Val(A(2)) esta vindo com 15 quando deveria ser 15,00, e agora? pelo que sei campos com decimal devem ter apóstrofe e aspas, estou correto?? se sim então não sei o q esta acontecendo..

 

:blink:

[luiz humberto 0]

Para que deixe os valores númericos com duas casas decimais, basta fazer assim:

FormatNumber(Val(A(0)),2)

Campos do tipo decimal faça desta forma:

'Para gravar no banco de dadosFormat("Val(A(0))", "#0.00")'Para mostrar dos dadosFormatNumber(SeuCampo, 2)

Qualquer dúvida poste ae...

[JCORTEZ 0]

Help,

gente o ficando :blink: , não é possivel.... Luiz usei o comando que você passou mas comessou dar uns erros estranhos, tipo " end command expected" ...

então tirei o comando e fiz uma movimentação fixa pra testar (apenas o campo com virgula) agora este trecho do código esta assim...

 

Do While Not EOF(F)       Line Input #F, sLine       ParseToArray sLine, A()              tst = "15.00"      Cria = ("insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values (" _       & Val(A(0)) & ",'" & A(1) & "'," & tst & "  )")       Debug.Print Cria       db.Execute CriaLoop

 

E estou recebendo a mensagem de erro abaixo

 

Run-time error '-2147217900(80040e14)'

Erro de sintaxa na instrução INSERT INTO

 

Olhando atraves do debug os dados estão OK (pelo menos parece..mas continuo sem saber onde estou errando...

 

valeu pelas dicas até agora pessoal...to aprendendo muito...

[luiz humberto 0]

Fiz algo errado.

 

Ao invés disso:

Format("Val(A(0))", "#0.00")

É assim:

" & Format(Val(A(0)), "#0.00") & "

Sua SQL:Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values(" & Format(A(0), "#0.00") & "," & Format(A(1), "#0.00") & "," & Format(tst, "#0.00") & ")"

Obs: Acho que não seja necessário utilizar a função Val.

[JCORTEZ 0]

ok, Luiz, :D Fiz um teste com a sua instrução e usando o debug o conteudo é este

insert into ImportaTexto(CODIGO, Desc, Valor)Values(40150,ACES DESCANCO DE CABECA IMP HP 840C,15,00)

Mas ainda continuo com a mensagem de erro no Insert....ai esta o codigo como esta agora ...

Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values(" _       & Val(A(0)) & "," & A(1) & "," & Format(A(2), "#0.00") & ")"       Debug.Print Cria       db.Execute Cria

o campo "tst" deletei e voltei para o original (A(2)....ta valendo a ajuda... http://forum.imasters.com.br/public/style_emoticons/default/joia.gif

[luiz humberto 0]

insert into ImportaTexto(CODIGO, Desc, Valor)Values(40150,ACES DESCANCO DE CABECA IMP HP 840C,15,00)

Está ocorrendo o erro referente ao 15,00 por causa da virgula, então tem que fazer assim:

Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values(" _      & Val(A(0)) & "," & A(1) & ",' " & Format(A(2), "#0.00" ') & ")"      Debug.Print Cria      db.Execute Cria

Coloque aspas simples.

[JCORTEZ 0]

ufa!!!, foi quase Luiz, kra não sei mais como perguntar http://forum.imasters.com.br/public/style_emoticons/default/blush.gif , pois nada do que se tenta resolve...

bem mas, não vou desistir... o codigo esta assim agora (como você me passou..)

 

Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values(" _

& Val(A(0)) & "," & A(1) & ", ' " & Format(A(2), "#0.00") & " ')"

Debug.Print Cria

insert into ImportaTexto(CODIGO, Desc, Valor)Values(40150,ACES DESCANCO DE CABECA IMP HP 840C, '15,00 ')

ja tentei mudar as as para simples,... de lugar.... etc... , mas continua o mesmo erro " erro de sintaxe no INSERT INTO"...

 

http://forum.imasters.com.br/public/style_emoticons/default/joia.gif valeu a todos que estão ajudando...

[luiz humberto 0]

Ops, faltou mais uma aspas simples.

Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values(" _& Val(A(0)) & ",' " & A(1) & " ', ' " & Format(A(2), "#0.00") & " ')"Debug.Print Cria

[JCORTEZ 0]

ainda nada gente... mais alguma sugestão ???? http://forum.imasters.com.br/public/style_emoticons/default/cry.gif

 

 

Cria = "insert into ImportaTexto(CODIGO, Desc, Valor)" & "Values(" _& Val(A(0)) & "," & A(1) & ", ' " & Format(A(2), "#0.00") & " ')"Debug.Print Cria

 

QUOTE

insert into ImportaTexto(CODIGO, Desc, Valor)Values(40150,ACES DESCANCO DE CABECA IMP HP 840C, '15,00 ')

 

 

ja tentei mudar as aspas para simples,... de lugar.... etc... , mas continua o mesmo erro " erro de sintaxe no INSERT INTO"...

 

http://forum.imasters.com.br/public/style_emoticons/default/thumbsup.gif valeu a todos