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
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
Sub deleteline(ByVal sfile As String, ByVal num As Long)
Dim sline As String, txt As Variant
Open sfile For Binary As #1
sline = Space(FileLen(1))
Get #1, , sline
Close #1
txt = Split(sline, vbCrLf)
If num > UBound(txt) + 1 Then Exit Sub
Dim all As New Collection
For I = 0 To UBound(txt)
all.Add txt(I) & vbCrLf
Next
all.Remove num
Kill sfile
Open sfile For Input As #1
For I = 1 To all.Count
Print #1, , all(I)
Next
Close #1
End Sub
Private Function DelFileLine(cfile As String, cLine As Integer) As Boolean
Dim Str As String
Dim I As Integer
Dim fsoTest As New FileSystemObject, file1 As File, ts As TextStream
Set file1 = fsoTest.GetFile(cfile)
Set ts = file1.OpenAsTextStream(ForReading)
I = 1
Do While Not ts.AtEndOfStream
If I <> cLine Then
Str = Str & ts.ReadLine & vbCrLf
Else
ts.ReadLine
End If
I = I + 1
Loop
Set ts = Nothing
Set ts = file1.OpenAsTextStream(ForWriting)
ts.Write (Str)
Set ts = Nothing
End Function
Private Sub Form_Load()
Dim bln As Boolean
bln = DelFileLine("f:\test.txt", 2)