Onde esta o Erro?
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
Discussão (24)
Carregando comentários...