by Waty Thierry (60 Submissions)
Category: Files/File Controls/Input/Output
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Tue 13th April 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Delete some lines in a text file
VBcoders
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 1155
ClientLeft = 1140
ClientTop = 1515
ClientWidth = 5280
Height = 1560
Left = 1080
LinkTopic = "Form1"
ScaleHeight = 1155
ScaleWidth = 5280
Top = 1170
Width = 54001
Begin VB.CommandButton CmdDeleteLine
Caption = "Delete Line"
Height = 495
Left = 3840
TabIndex = 4
Top = 360
Width = 1215
End
Begin VB.TextBox TargetText
Height = 285
Left = 840
TabIndex = 3
Text = "Tim"
Top = 600
Width = 2775
End
Begin VB.TextBox FileText
Height = 285
Left = 840
TabIndex = 0
Text = "C:\Temp\Subs.txt"
Top = 240
Width = 2775
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Target"
Height = 195
Index = 1
Left = 120
TabIndex = 2
Top = 600
Width = 465
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "File"
Height = 195
Index = 0
Left = 120
TabIndex = 1
Top = 240
Width = 240
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Sub CmdDeleteLine_Click()
Const MAX_PATH = 260
Const NAME_LEN = MAX_PATH + 80
Dim inname As String
Dim strlen As Integer
Dim outpath As String
Dim outname As String
Dim infile As Integer
Dim outfile As Integer
Dim one_line As String
Dim target As String
Dim deleted As Integer
On Error GoTo DeleteLineError
' Open the input file.
inname = FileText.Text
infile = FreeFile
Open inname For Input As infile
' Open the output file.
outpath = Space$(NAME_LEN)
strlen = GetTempPath(NAME_LEN, outpath)
If strlen = 0 Then
MsgBox "Error getting temporary file path."
Exit Sub
Else
outpath = Left$(outpath, strlen)
End If
outname = Space$(NAME_LEN)
If GetTempFileName(outpath, "tmp", _
0, outname) = 0 _
Then
MsgBox "Error getting temporary file name."
Exit Sub
End If
strlen = InStr(outname, vbNullChar) - 1
If strlen > 0 Then _
outname = Left$(outname, strlen)
outfile = FreeFile
Open outname For Output As outfile
MousePointer = vbHourglass
DoEvents
' Copy the file skipping lines containing the
' target.
deleted = 0
target = TargetText.Text
Do While Not EOF(infile)
Line Input #infile, one_line
If InStr(one_line, target) = 0 Then
Print #outfile, one_line
Else
deleted = deleted + 1
End If
Loop
' Close the files.
Close infile
Close outfile
' Delete the original file.
Kill inname
' Give the new file the old name.
Name outname As inname
MsgBox Format$(deleted) & " lines deleted."
DeleteLineError:
MousePointer = vbDefault
Exit Sub
End Sub
