PROGRESSBAR REAL NA IMPORTACAO

XXXANGELSXXX 22/07/2010 16:04:12
#348174
Meu povo, vejam só eu estou importando um arquivo texto imenso aqui para dentro de uma tabela no banco de dados on line, entao da um delay de uns 15 minutos, so importando o mesmo, so que o seguinte, queria colocar uma progressbar, e o sistema ir importando e preenchendo essa progress para o cliente nao ficar perdido na importaçao.. estou anexando o codigo abaixo se alguem puder ajudar com o negocio.. penso que tenho que contar os registros do arquivo txt para funcionar.. e colocar a propriedade max .. mas num sei fazer..



Sub ImportarClientesAdd()
    If txtAnexo.Text = Empty Then
        MsgBox [Ô]Selecione o Arquivo para Importação![Ô], vbCritical, [Ô]Tech Size[Ô]

        Exit Sub
    Else

        Dim Coluna() As String
        Dim F As Long, sLine As String
        F = FreeFile
        Open txtAnexo.Text For Input As F
        Do While Not EOF(F)
            Line Input #F, sLine
            Coluna = Split(sLine, [Ô];[Ô])
            Set myRS = New ADODB.Recordset
            myRS.Open [Ô]SELECT * FROM cadpessoas Where pesscodigo = [ô][Ô] & Format(Coluna(0), [Ô]000000[Ô]) & [Ô][ô][Ô], Conexao, adOpenDynamic, adLockReadOnly
        
            If myRS.EOF Then
               StrSql = [Ô]INSERT INTO cadpessoas([Ô]
                StrSql = StrSql & [Ô]pesscodigo,pessnome,pesscontato,pesscnpj,[Ô]
                StrSql = StrSql & [Ô]pessestadual,pesstelefone,pesstipolog,[Ô]
                StrSql = StrSql & [Ô]pesslogradouro , pessnumero, pesscomplemento,[Ô]
                StrSql = StrSql & [Ô]pessbairro,pesscep,pesscidade,pessestado,pessrevenda,pessemail,pesscat)[Ô]
                StrSql = StrSql & [Ô] Values ([ô][Ô]
                StrSql = StrSql & Format(Coluna(0), [Ô]000000[Ô]) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(1))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(2))) & [Ô][ô],[ô][Ô]
                If Len(Coluna(3)) <= 11 Then
                    Coluna(3) = Format(Coluna(3), [Ô]@@@.@@@.@@@-@@[Ô])
                Else
                    Coluna(3) = Format(Coluna(3), [Ô]@@.@@@.@@@/@@@@-@@[Ô])
                End If
                StrSql = StrSql & Coluna(3) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(4) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Format(Coluna(5), [Ô](@@)@@@@-@@@@[Ô]) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(6))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(7))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(8) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(9))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(10))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Format(Coluna(11), [Ô]@@@@@-@@@[Ô]) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(12))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(13) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(14) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(15) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & CStr(Left(txtEmpresa.Text, 4)) & [Ô][ô])[Ô]
                Conexao.Execute (StrSql)
            End If
        Loop
    
    End If
    Close #F
    myRS.Close
    Set myRS = Nothing

End Sub
JOAOBENEVIDES 22/07/2010 18:02:13
#348203
eu varia assim
Sub ImportarClientesAdd()
If txtAnexo.Text = Empty Then
MsgBox [Ô]Selecione o Arquivo para Importação![Ô], vbCritical, [Ô]Tech Size[Ô]

Exit Sub
Else

Dim Coluna() As String
Dim x as Interger
Dim F As Long, sLine As String
F = FreeFile
Open txtAnexo.Text For Input As F
Do While Not EOF(F)
Line Input #F, sLine
Coluna = Split(sLine, [Ô];[Ô])
Set myRS = New ADODB.Recordset
myRS.Open [Ô]SELECT * FROM cadpessoas Where pesscodigo = [ô][Ô] & Format(Coluna(0), [Ô]000000[Ô]) & [Ô][ô][Ô], Conexao, adOpenDynamic, adLockReadOnly

x=0
suabarra= X
If myRS.EOF Then
StrSql = [Ô]INSERT INTO cadpessoas([Ô]
StrSql = StrSql & [Ô]pesscodigo,pessnome,pesscontato,pesscnpj,[Ô]
StrSql = StrSql & [Ô]pessestadual,pesstelefone,pesstipolog,[Ô]
StrSql = StrSql & [Ô]pesslogradouro , pessnumero, pesscomplemento,[Ô]
StrSql = StrSql & [Ô]pessbairro,pesscep,pesscidade,pessestado,pessrevenda,pessemail,pesscat)[Ô]
StrSql = StrSql & [Ô] Values ([ô][Ô]
StrSql = StrSql & Format(Coluna(0), [Ô]000000[Ô]) & [Ô][ô],[ô][Ô]
StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(1))) & [Ô][ô],[ô][Ô]
StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(2))) & [Ô][ô],[ô][Ô]
If Len(Coluna(3)) <= 11 Then
Coluna(3) = Format(Coluna(3), [Ô]@@@.@@@.@@@-@@[Ô])
Else
Coluna(3) = Format(Coluna(3), [Ô]@@.@@@.@@@/@@@@-@@[Ô])
End If
StrSql = StrSql & Coluna(3) & [Ô][ô],[ô][Ô]
StrSql = StrSql & Coluna(4) & [Ô][ô],[ô][Ô]
StrSql = StrSql & Format(Coluna(5), [Ô](@@)@@@@-@@@@[Ô]) & [Ô][ô],[ô][Ô]
StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(6))) & [Ô][ô],[ô][Ô]
StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(7))) & [Ô][ô],[ô][Ô]
StrSql = StrSql & Coluna(8) & [Ô][ô],[ô][Ô]
StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(9))) & [Ô][ô],[ô][Ô]
StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(10))) & [Ô][ô],[ô][Ô]
StrSql = StrSql & Format(Coluna(11), [Ô]@@@@@-@@@[Ô]) & [Ô][ô],[ô][Ô]
StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(12))) & [Ô][ô],[ô][Ô]
StrSql = StrSql & Coluna(13) & [Ô][ô],[ô][Ô]
StrSql = StrSql & Coluna(14) & [Ô][ô],[ô][Ô]
StrSql = StrSql & Coluna(15) & [Ô][ô],[ô][Ô]
StrSql = StrSql & CStr(Left(txtEmpresa.Text, 4)) & [Ô][ô])[Ô]
Conexao.Execute (StrSql)
End If
x=x+1
Loop

End If
Close #F
myRS.Close
Set myRS = Nothing

End Sub
XXXANGELSXXX 22/07/2010 18:18:43
#348204
boa noite, amigo.. nao deu certo nao, a barrinha nem começou a processar..
RFTD 22/07/2010 18:43:27
#348205 
Sub ImportarClientesAdd()
    If txtAnexo.Text = Empty Then
        MsgBox [Ô]Selecione o Arquivo para Importação![Ô], vbCritical, [Ô]Tech Size[Ô]

        Exit Sub
    Else

        Dim Coluna() As String
        Dim x  as Interger
        Dim F As Long, sLine As String
        F = FreeFile
        Open txtAnexo.Text For Input As F
        Do While Not EOF(F)
            Line Input #F, sLine
            Coluna = Split(sLine, [Ô];[Ô])
            Set myRS = New ADODB.Recordset
            myRS.Open [Ô]SELECT * FROM cadpessoas Where pesscodigo = [ô][Ô] & Format(Coluna(0), [Ô]000000[Ô]) & [Ô][ô][Ô], Conexao, adOpenDynamic, adLockReadOnly
      
suabarra.Min = 0
suabarra.Max = myRS.RecordCount
            If myRS.EOF Then
               StrSql = [Ô]INSERT INTO cadpessoas([Ô]
                StrSql = StrSql & [Ô]pesscodigo,pessnome,pesscontato,pesscnpj,[Ô]
                StrSql = StrSql & [Ô]pessestadual,pesstelefone,pesstipolog,[Ô]
                StrSql = StrSql & [Ô]pesslogradouro , pessnumero, pesscomplemento,[Ô]
                StrSql = StrSql & [Ô]pessbairro,pesscep,pesscidade,pessestado,pessrevenda,pessemail,pesscat)[Ô]
                StrSql = StrSql & [Ô] Values ([ô][Ô]
                StrSql = StrSql & Format(Coluna(0), [Ô]000000[Ô]) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(1))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(2))) & [Ô][ô],[ô][Ô]
                If Len(Coluna(3)) <= 11 Then
                    Coluna(3) = Format(Coluna(3), [Ô]@@@.@@@.@@@-@@[Ô])
                Else
                    Coluna(3) = Format(Coluna(3), [Ô]@@.@@@.@@@/@@@@-@@[Ô])
                End If
                StrSql = StrSql & Coluna(3) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(4) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Format(Coluna(5), [Ô](@@)@@@@-@@@@[Ô]) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(6))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(7))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(8) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(9))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(10))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Format(Coluna(11), [Ô]@@@@@-@@@[Ô]) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(12))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(13) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(14) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(15) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & CStr(Left(txtEmpresa.Text, 4)) & [Ô][ô])[Ô]
                Conexao.Execute (StrSql)
            End If
     suabarra.value = suabarra + 1
        Loop
    
    End If
    Close #F
    myRS.Close
    Set myRS = Nothing

End Sub


Seria mais ou menos assim.
Eu não to com o vb aki para testar, então pode ter erro.
XXXANGELSXXX 23/07/2010 18:46:52
#348304
Amigos, vejam so eu nao posso contar o recordset, eu tenho que contar quantos registros tem no arquivo txt, ou seja, talvez o meu banco de dados vai estar com a tabela em branco, portanto nao vai dar certo, eu tenho que contar os 15 mil registros do arquivo txt.. entenderam? como faço para contar os registros do txt?
RFTD 24/07/2010 00:50:36
#348315 

Sub ImportarClientesAdd()
    If txtAnexo.Text = Empty Then
        MsgBox [Ô]Selecione o Arquivo para Importação![Ô], vbCritical, [Ô]Tech Size[Ô]

        Exit Sub
    Else

        Dim Coluna() As String
        Dim x  as Interger
		dim iUpdates as Interger
        Dim F As Long, sLine As String
        F = FreeFile
        Open txtAnexo.Text For Input As F
		Line Input #F, sLine        
		[ô]Conta as linhas
		 For iMaxUP = LBound(Coluna) To UBound(Coluna) 
         iUpdates = iUpdates + 1
         Next iMaxUP
		suabarra.Min = 0
        suabarra.Max = iUpdates
		
        Do While Not EOF(F)            
            Set myRS = New ADODB.Recordset
            myRS.Open [Ô]SELECT * FROM cadpessoas Where pesscodigo = [ô][Ô] & Format(Coluna(0), [Ô]000000[Ô]) & [Ô][ô][Ô], Conexao, adOpenDynamic, adLockReadOnly
      
            Coluna = Split(sLine, [Ô];[Ô])
            If myRS.EOF Then
               StrSql = [Ô]INSERT INTO cadpessoas([Ô]
                StrSql = StrSql & [Ô]pesscodigo,pessnome,pesscontato,pesscnpj,[Ô]
                StrSql = StrSql & [Ô]pessestadual,pesstelefone,pesstipolog,[Ô]
                StrSql = StrSql & [Ô]pesslogradouro , pessnumero, pesscomplemento,[Ô]
                StrSql = StrSql & [Ô]pessbairro,pesscep,pesscidade,pessestado,pessrevenda,pessemail,pesscat)[Ô]
                StrSql = StrSql & [Ô] Values ([ô][Ô]
                StrSql = StrSql & Format(Coluna(0), [Ô]000000[Ô]) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(1))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(2))) & [Ô][ô],[ô][Ô]
                If Len(Coluna(3)) <= 11 Then
                    Coluna(3) = Format(Coluna(3), [Ô]@@@.@@@.@@@-@@[Ô])
                Else
                    Coluna(3) = Format(Coluna(3), [Ô]@@.@@@.@@@/@@@@-@@[Ô])
                End If
                StrSql = StrSql & Coluna(3) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(4) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Format(Coluna(5), [Ô](@@)@@@@-@@@@[Ô]) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(6))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(7))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(8) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(9))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(10))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Format(Coluna(11), [Ô]@@@@@-@@@[Ô]) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & f_RemoveAcento(MMCase(Coluna(12))) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(13) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(14) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & Coluna(15) & [Ô][ô],[ô][Ô]
                StrSql = StrSql & CStr(Left(txtEmpresa.Text, 4)) & [Ô][ô])[Ô]
                Conexao.Execute (StrSql)
            End If
     suabarra.value = suabarra + 1
        Loop
    
    End If
    Close #F
    myRS.Close
    Set myRS = Nothing

End Sub


Agora deve funcionar
DANIKULL 25/07/2010 19:49:31
#348407
Citação:

:
Amigos, vejam so eu nao posso contar o recordset, eu tenho que contar quantos registros tem no arquivo txt, ou seja, talvez o meu banco de dados vai estar com a tabela em branco, portanto nao vai dar certo, eu tenho que contar os 15 mil registros do arquivo txt.. entenderam? como faço para contar os registros do txt?



Boa noite.

Tem como você postar o arquivo texto ou algo bem parecido em sua estrutura para que possamos te ajudar??
Eu tenho uma rotina que conta linhas em arquivo texto e é bem simples....

Ate mais...
EDERMIR 25/07/2010 21:36:37
#348414
ANGELS.

A primeira pergunta é saber se o TXT tem sempre o mesmo número de registros. Se não tem, então teremos que saber quantos são para visualizar a barra corretamente.

Lembre-se que saber quantas linhas existem, você terá que ler todas as linhas. Então não vale a pena ler tudo somente para mostrar a barra.

Você pode fazer uma animação para a importação. Algo como preencher o PROGRESS BAR a cada 5000 registros. Neste caso você exibe uma TEXT com a quantidade realmente lida e na BARRA você exibe a cada vez que for preenchida:
1 [xxxxxxxxxxx] 5000
5001 [xxxxxxxxxxx] 10000
10001 [xxxxxxxxxxx] 15000
15001 [xxxxxxxxxxx] 20000
DANIKULL 26/07/2010 09:40:43
#348441
Citação:

:
Amigos, vejam so eu nao posso contar o recordset, eu tenho que contar quantos registros tem no arquivo txt, ou seja, talvez o meu banco de dados vai estar com a tabela em branco, portanto nao vai dar certo, eu tenho que contar os 15 mil registros do arquivo txt.. entenderam? como faço para contar os registros do txt?



bom dia.

Desenvolvi um exemplo bem simples e prático de como você pode fazer para colocar o progressbar na sua aplicação.
Pega ai o projeto da uma boa olhada e depois você me fala se é mais ou menos o que você quer, blz??

Dúvidas poste novamente.
NETMANIA 26/07/2010 10:10:57
#348442
Danikull, você pode postar oe exempo novamente que não estou conseguindo abrir o arquivo que segue em anexo.
DANIKULL 26/07/2010 13:32:09
#348486 Resposta escolhida
Pessoal, boa tarde.

Esqueci de mencionar que o arquivo foi zipado com winzip 14 no formato zipx por ser mais compressivo, mais em fim, estou diponibilizando novamente desta vez em zip padrão e dentro dele em rar, pois devidoo ao Banco de Dados ser access 2007 formato accdb ficou muito grande para o exemplo.
Tópico encerrado , respostas não são mais permitidas
Voltar