CRIAR UM ARQUIVO DE TEXTO
Bom pessoal estou aqui mais uma vez para pedir a ajuda de vocês
é o seguinte tenho Três procedimento como os abaixo:
Bom essa rotina faz o seguinte:
Pega um arquivo e LÊ ele comparando com uma ABA onde tem os cadastro do produtos
Ou seja o procedimento LERGRAVAR Abre um arquivo e lê chama o procedimento BUSCA que
compara se o código lido no arquivo esta cadastrado. Se estiver vai na coluna e verifica a quantidade
de repetição que o código deve repetir e grava em um outro arquivo.
Até aqui tudo beleza.
o problema esta no procedimento RESTORE que abre esse segundo arquivo e lê
e a cada seis linhas coloca em uma só linha separados por [Ô] | [Ô] pipe no entanto esta fazendo isso só
que esta ficando códigos para tráz.
Se em anexo os arquivos.
é o seguinte tenho Três procedimento como os abaixo:
Public Sub LerGravar()
Dim PathFile As String
Dim NameFile As String
Dim NameFile1 As String
Dim LineTmp As String
Dim Codigo As String
Dim Preco As String
Dim Validador As String
Dim Pagina As String
PathFile = ThisWorkbook.Path
NameFile = [Ô]ALTERADO[Ô]
NameFile1 = [Ô]FEIRAO[Ô]
Gravar = [Ô][Ô]
Open (PathFile & [Ô]\[Ô] & NameFile) For Input As #1
Open (PathFile & [Ô]\[Ô] & NameFile1) For Output As #2
Do While Not EOF(1)
Line Input #1, LineTmp
If Len(LineTmp) > 4 Then
Codigo = Trim(Replace(Mid(LineTmp, 1, 9), [Ô]-[Ô], [Ô][Ô]))
If Left(Codigo, 1) = [Ô]0[Ô] Then
Codigo = Format(Codigo, [Ô]00000[Ô])
End If
Validador = Trim(Mid(LineTmp, 10, 1))
Preco = Trim(Replace(Mid(LineTmp, 66, 9), [Ô],[Ô], [Ô][Ô]))
If Trim(Mid(LineTmp, 73, 3)) = [Ô]Pg.[Ô] Then
Pagina = Trim(Mid(LineTmp, 73, 8))
End If
If IsNumeric(Codigo) And IsNumeric(Preco) And Validador = [Ô][Ô] Then
Gravar = [Ô][Ô]
Preco = Left(Preco, Len(Preco) - 2) & [Ô],[Ô] & Right(Preco, 2)
Busca Codigo, Preco
If Gravar <> [Ô][Ô] Then
Print #2, Gravar
End If
End If
End If
Loop
Close #1
Close #2
Sheets(1).Select
End Sub
Public Sub Busca(ByVal CodArq As String, ByVal PrecoArq As String)
Dim FimPlan As String
Dim Consulta As Integer
Dim QtdArq As Integer
Dim SCodPlan As String
Dim SQtdPlan As String
Dim WSCod As Worksheet
Dim x As Integer
[ô]SCod recebe o valor do CODIGO lido no ARQ_TXT
[ô]SCod = CodPlan
If CodArq <> [Ô][Ô] Then
[ô]Aqui você indica o nome da ABA que vai ser realizada a pesquisa
Set WSCod = Sheets([Ô]Plan2[Ô])
[ô]Consulta Dados
WSCod.Activate
[ô]Aqui você indica até qual linha você quer que a busca seja feita
FimPlan = Range([Ô]A115[Ô]).End(xlUp).Row
[ô]O for começa na linha que deseja até o limite que foi dado a variável FimPlan no meu caso na linha 3
For Consulta = 1 To FimPlan
With WSCod
SCodPlan = .Cells(Consulta, 1).Value
SQtdPlan = .Cells(Consulta, 4).Value
If CodArq = SCodPlan Then
QtdArq = CInt(SQtdPlan)
If QtdArq <> 0 Then
Gravar = [Ô][Ô]
For x = 1 To QtdArq
If QtdArq <> x Then
Gravar = Gravar & CodArq & [Ô]|[Ô] & PrecoArq & vbCrLf
Else
Gravar = Gravar & CodArq & [Ô]|[Ô] & PrecoArq
End If
Next
End If
End If
End With
Next
End If
End Sub
Public Sub Restore()
Dim Campo As Variant
Dim PathFile As String
Dim NameFile, NameFile1 As String
Dim LineTmp As String
Dim Validador As String
Dim Codigo As String
Dim Preco As String
Dim Cont, i As Integer
[ô]Dim QtdItensPorPagina As Long
[ô]Dim QtdItensTotal As Long
PathFile = ThisWorkbook.Path
NameFile = [Ô]FEIRAO[Ô]
NameFile1 = [Ô]FEIRAO1[Ô]
Gravar = [Ô][Ô]
Cont = 1
[ô]QtdItensPorPagina = 0
[ô]QtdItensTotal = 0
Open (PathFile & [Ô]\[Ô] & NameFile) For Input As #1
Open (PathFile & [Ô]\[Ô] & NameFile1) For Output As #2
Do While Not EOF(1)
Line Input #1, LineTmp
If Cont = 6 Then
Gravar = Gravar & Trim(Codigo) & [Ô]|[Ô] & Trim(Preco)
Print #2, Gravar
Gravar = [Ô][Ô]
Codigo = [Ô][Ô]
Preco = [Ô][Ô]
Cont = 0
Else
Campo = Split(LineTmp, [Ô]|[Ô])
For i = 0 To UBound(Campo)
Codigo = Str(Campo(i))
Preco = Str(Campo(i + 1))
MsgBox Codigo & [Ô]-[Ô] & Preco
Exit For
Next
Gravar = Gravar & Trim(Codigo) & [Ô]|[Ô] & Trim(Preco) & [Ô]|[Ô]
End If
Cont = Cont + 1
Loop
Close #1
Close #2
End Sub
Bom essa rotina faz o seguinte:
Pega um arquivo e LÊ ele comparando com uma ABA onde tem os cadastro do produtos
Ou seja o procedimento LERGRAVAR Abre um arquivo e lê chama o procedimento BUSCA que
compara se o código lido no arquivo esta cadastrado. Se estiver vai na coluna e verifica a quantidade
de repetição que o código deve repetir e grava em um outro arquivo.
Até aqui tudo beleza.
o problema esta no procedimento RESTORE que abre esse segundo arquivo e lê
e a cada seis linhas coloca em uma só linha separados por [Ô] | [Ô] pipe no entanto esta fazendo isso só
que esta ficando códigos para tráz.
Se em anexo os arquivos.
Pelo que percebi, quando a leitura chega na linha 6, você atribui na variavel GRAVA a linha desejada.
Neste caso, a linha deve ser lida como se não houvesse chego na lihha 6. Faça a seguinte alteração:
Neste caso, a linha deve ser lida como se não houvesse chego na lihha 6. Faça a seguinte alteração:
Do While Not EOF(1)
Line Input #1, LineTmp
Campo = Split(LineTmp, [Ô]|[Ô])
Codigo = Str(Campo(0))
Preco = Str(Campo(1))
MsgBox Codigo & [Ô]-[Ô] & Preco
Gravar = Gravar & CAMPO(0) & [Ô]|[Ô] & CAMPO(1) & [Ô]|[Ô]
If Cont = 6 Then
Print #2, Gravar
Gravar = [Ô][Ô]
Codigo = [Ô][Ô]
Preco = [Ô][Ô]
Cont = 0
End If
Cont = Cont + 1
Loop
Desculpe pessoal incomodar você mais consegui resolver
Era só colocar um outro PRINT fora do loop para imprimir o restante
EDERMIR pela força.
VLW.
Era só colocar um outro PRINT fora do loop para imprimir o restante
EDERMIR pela força.
VLW.
Tópico encerrado , respostas não são mais permitidas