COLOCAR CONTADOR EM CODIGO

PAYDANA 25/05/2013 14:10:21
#424022
Este código deleta toda linha que tenha por exemplo [Ô]01[Ô]

Estou tentando aqui colocar um contador pra saber quantas linhas foram deletadas e não estou conseguindo

Dim FSO As New FileSystemObject
Dim ArqTxt As TextStream
Dim Texto As String

Private Sub Form_Load()
Set ArqTxt = FSO.OpenTextFile(App.Path & [Ô]inho.txt[Ô], ForReading, True)
Texto = ArqTxt.ReadAll
Me.Caption = [Ô]Arquivo Possui [Ô] & Format(ArqTxt.Line, [Ô]0000[Ô]) & [Ô] Linhas[Ô]
ArqTxt.Close
End Sub

Private Sub Command1_Click()
EliminaLinha Text1.Text, App.Path & [Ô]inho.txt[Ô]
Set ArqTxt = FSO.OpenTextFile(App.Path & [Ô]inho.txt[Ô], ForReading, True)
Texto = ArqTxt.ReadAll
Me.Caption = [Ô]Arquivo Possui [Ô] & Format(ArqTxt.Line, [Ô]0000[Ô]) & [Ô] Linhas[Ô]
ArqTxt.Close
End Sub

[ô]EliminaLinha [Ô]20[Ô], App.Path & [Ô]inho.txt[Ô]

Public Sub EliminaLinha(Texto As String, Arquivo As String)
Dim oFS As FileSystemObject
Dim oTS As TextStream
Dim oTSB As TextStream
Dim sLinha As String
Dim sTemp As String
Set oFS = New FileSystemObject
sTemp = App.Path & [Ô]\[Ô] & oFS.GetTempName
If oFS.FileExists(App.Path & [Ô]inho.txt[Ô]) = True Then
Set oTS = oFS.OpenTextFile(Arquivo, ForReading)

Set oTSB = oFS.OpenTextFile(sTemp, ForWriting, True)
While Not oTS.AtEndOfStream = True
sLinha = Empty
sLinha = oTS.ReadLine
If InStr(1, sLinha, Texto, vbTextCompare) = 0 Then
oTSB.WriteLine sLinha
End If
Wend
oTSB.Close
oTS.Close
oFS.DeleteFile Arquivo
oFS.CopyFile sTemp, Arquivo, True
oFS.DeleteFile sTemp
End If
Set oFS = Nothing
Set oTS = Nothing
Set oTSB = Nothing
sLinha = Empty
sTemp = Empty
[ô]MsgBox .ReadAll
End Sub
PROFESSOR 26/05/2013 14:57:19
#424040 Resposta escolhida
O contador deve ser incrementado com as linhas que você não copia.
Dica: A Sub EliminaLinha pode ser alterada para Function, de forma que retorne o total de linhas excluídas.

Public Sub EliminaLinha(Texto As String, Arquivo As String)
Dim oFS As FileSystemObject
Dim oTS As TextStream
Dim oTSB As TextStream
Dim sLinha As String
Dim sTemp As String
Dim nExcluidas As Long
Set oFS = New FileSystemObject
sTemp = App.Path & [Ô]\[Ô] & oFS.GetTempName
If oFS.FileExists(App.Path & [Ô]inho.txt[Ô]) = True Then
    Set oTS = oFS.OpenTextFile(Arquivo, ForReading)
    Set oTSB = oFS.OpenTextFile(sTemp, ForWriting, True)
    While Not oTS.AtEndOfStream = True
        sLinha = Empty
        sLinha = oTS.ReadLine
        If InStr(1, sLinha, Texto, vbTextCompare) = 0 Then
            oTSB.WriteLine sLinha
        Else
            nExcluidas = nExcluidas + 1
        End If
    Wend
    oTSB.Close
    oTS.Close
    oFS.DeleteFile Arquivo
    oFS.CopyFile sTemp, Arquivo, True
    oFS.DeleteFile sTemp
End If
Set oFS = Nothing
Set oTS = Nothing
Set oTSB = Nothing
sLinha = Empty
sTemp = Empty
If (nExcluidas > 0) Then
    MsgBox [Ô]Foram excluídas [Ô] & nExcluidas & [Ô] linhas.[Ô]
End If
End Sub
PAYDANA 28/05/2013 20:41:30
#424174
Perfeito!
Obrigado Professor.
Tópico encerrado , respostas não são mais permitidas
Voltar