Fórum Excel Bácico, Avançado e Vba
Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.
Fórum Excel Bácico, Avançado e Vba

Este fórum é destina a usuário de Excel, que queiram compartilhar informações a básicas, avançadas e programação em VBA...
 
InícioInício  Últimas imagensÚltimas imagens  ProcurarProcurar  RegistarRegistar  Entrar  

 

 importar txt e manter dados

Ir para baixo 
AutorMensagem
naursouto




Mensagens : 2
Data de inscrição : 14/06/2012

importar txt e manter dados Empty
MensagemAssunto: importar txt e manter dados   importar txt e manter dados EmptyQui Jun 14, 2012 10:37 pm

Boa TArde

estou com uma macro que importa txt , ate ai tudo ok , o que eu quero é , fazer varias importações , mantendo as anteriores.


Algens pode ajudar
segue codigo


Sub Importar()
Dim nString(0 To 14)
Dim LinhaDeTexto, Lin, Resp1, Resp2, Quant, Qual, nLin, Cont 'várias variáveis
Dim wsResumo As Worksheet
Set wsResumo = ThisWorkbook.Worksheets("Plan2") '
On Error GoTo InterrupçãoUsuário 'tratador de possíveis erros
If Plan1.Range("F2") = "" Then 'se a célula com o nome do arquivo for branco não faz nada
MsgBox "Preencha o nome do Arquivo que desaja Importar", vbInformation, "IMPORTAÇÃO DE ARQUIVOS"
Else
Resp1 = MsgBox("Deseja Importar", vbQuestion + vbYesNo, "IMPORTAÇÃO DE ARQUIVOS") 'se possuir nome do arquivo
If Resp1 = vbYes Then
Plan1.Range("g5") = 0 'começa o percentual de acompanhamento com zero "célula g5"
Qual = 1 'qual linha está sendo importada "começa com a 1"
'Lin = wsResumo.Range("B65536").End(xlUp).Row + 1 'define a linha que começará a importação na plan2'
Lin = wsResumo.Range("A" & Rows.Count).End(xlUp).Row + 1
Lin = 2
nLin = 2 'linha para controle do grupo do arquivo texto
Quant = FileLen(Plan1.Range("F2")) / 25000 'quantidade de linhas a serem importadas
Open Plan1.Range("F2") For Input As #1 ' Abre o arquivo.
Do While Not EOF(1) ' Faz o loop até o fim do arquivo.
Line Input #1, LinhaDeTexto ' Lê a linha para a variável.
If LinhaDeTexto = "" Then ' se a linha a ser importada for branca não faz nada
Qual = Qual + 1 / 2
ElseIf IsNumeric(Trim(Left(LinhaDeTexto, 2))) Then 'se os 2 primeiros digitis da linha a ser importada for numerico então importa
nString(0) = Trim(Left(LinhaDeTexto, 2)) & "." & Trim(Right(Left(LinhaDeTexto, 4), 3)) 'os strings são as divisões do arquivo texto
nString(1) = Trim(Right(Left(LinhaDeTexto, 73), 40)) 'nome'
nString(2) = Trim(Right(Left(LinhaDeTexto, 478), 55)) 'endereco'
nString(3) = Trim(Right(Left(LinhaDeTexto, 483), 5)) 'numero'
nString(4) = Trim(Right(Left(LinhaDeTexto, 557), 34)) 'bairro'
nString(5) = Trim(Right(Left(LinhaDeTexto, 607), 50)) 'cidade'
nString(6) = Trim(Right(Left(LinhaDeTexto, 610), 3)) 'estado'
nString(7) = Trim(Right(Left(LinhaDeTexto, 423), 10)) 'cep'
nString(Cool = Trim(Right(Left(LinhaDeTexto, 32), 11)) 'cpf'
nString(9) = Trim(Right(Left(LinhaDeTexto, 1642), 19)) 'cartao'
nString(10) = Trim(Right(Left(LinhaDeTexto, 1657), 1)) 'status'

Plan2.Range("A" & Lin) = nString(0)
Plan2.Range("B" & Lin) = nString(1)
Plan2.Range("C" & Lin) = nString(2)
Plan2.Range("D" & Lin) = nString(3)
Plan2.Range("E" & Lin) = nString(4)
Plan2.Range("F" & Lin) = nString(5)
Plan2.Range("G" & Lin) = nString(6)
Plan2.Range("H" & Lin) = nString(7)
Plan2.Range("I" & Lin) = nString(Cool
Plan2.Range("J" & Lin) = nString(9)
Plan2.Range("K" & Lin) = nString(10)


Qual = Qual + 1 'aumenta uma contagem a linha a ser importada
Lin = Lin + 1 'aumenta uma linha na plan2
ElseIf Trim(Left(LinhaDeTexto, 5)) = "TOTAL" Then 'se a linha a ser importada começas com TOTAL então volta e preenche o grupo
For Cont = nLin To Lin - 1
Plan2.Range("P" & Cont) = Trim(Right(Left(LinhaDeTexto, 39), 24))
nLin = nLin + 1
Next
Qual = Qual + 1
End If
DoEvents
Plan1.Range("g5") = Format(Qual / Quant, "0.00%") 'atualiza o percentual de acompanhamento
Plan1.Range("h5") = (Val(Plan1.Range("g5"))) * 0.9
DoEvents
Loop
Close #1
Plan1.Range("g5") = Format(1, "0.00%")
Plan1.Range("h5") = (Val(Plan1.Range("g5"))) * 0.9
Resp2 = MsgBox("IMPORTAÇÃO FINALIZADA !", vbInformation, "IMPORTAÇÃO DE ARQUIVOS")
End If
End If
Exit Sub
InterrupçãoUsuário:
MsgBox "OCORREU UM ERRO! " & Chr(10) & Err.Number & " - " & Err.Description & Chr(10) & LinhaDeTexto, 48, "ZIM"
Close #1
End Sub
Ir para o topo Ir para baixo
 
importar txt e manter dados
Ir para o topo 
Página 1 de 1
 Tópicos semelhantes
-
» Importar base de dados de uma página WEB
»  problema ao importar dados externos da web
» Importar Dados de sub-pasta com diversas condições
» importar varios txt - dados em linhas sem separacao
» Copiar Dados de Formulário Para Banco de Dados Salvo no disco C:

Permissões neste sub-fórumNão podes responder a tópicos
Fórum Excel Bácico, Avançado e Vba :: Avançado/VBA :: Excel Avançado/VBA-
Ir para: