CRIAR UM ARQUIVO DE TEXTO

FILMAN 28/08/2011 14:47:35
#382672
Bom pessoal estou aqui mais uma vez para pedir a ajuda de vocês

é 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.
EDERMIR 28/08/2011 17:25:51
#382679
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:

    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
FILMAN 29/08/2011 12:47:01
#382718
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.
Tópico encerrado , respostas não são mais permitidas