IMPORTAR TXT

NAUR 17/01/2012 09:30:39
#393410

Tenho um arquivo txt e quero importar para o excel só que importa somente a primeira linha.
segue codigo abaixo.

Sub Importar()
Dim nString(0 To 14)
Dim LinhaDeTexto, Lin, Resp1, Resp2, Quant, Qual, nLin, Cont [ô]várias variáveis
[ô]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 = 2 [ô]define a linha que começará a importação na plan2
nLin = 2 [ô]linha para controle do grupo do arquivo texto
Quant = FileLen(Plan1.Range([Ô]F2[Ô])) / 132 [ô]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, 6))) Then [ô]se os 6 primeiros digitis da linha a ser importada for numerico então importa
nString(0) = Trim(Left(LinhaDeTexto, 6)) & [Ô].[Ô] & Trim(Right(Left(LinhaDeTexto, 8), 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(8) = 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(8)
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