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
Voltar