Удалить определенную строку в txt файле

Dim Filen
Dim k As Integer
Dim tS As String
Filen = FreeFile
 
Open ("C:\TIME\hours.txt") For Output As #Filen
 
For k = 1 To Val(Label1) + 1
Print #Filen, tS
Next k
If k = Val(Label1) Then Print #Filen,
Close #Filen

Private Sub Command1_Click()
' Перезапись файла с удалением строки
Dim St(10) As String
Open "c:\1.txt" For Input As #1
    Dim S As String
    While Not EOF(1)
        n = n + 1
        Input #1, S
        St(n) = S
    Wend
Close #1
 
Open "c:\1.txt" For Output As #1
    For i = 1 To 10
        If i <> 7 Then ' Убираем 7-ю строку
            Print #1, St(i)
        End If
    
    Next
Close #1
End Sub
 
Private Sub Form_Load()
' Создадим файл на 10 строк
Open "c:\1.txt" For Output As #1
For i = 1 To 10
    Print #1, "String №" & i
Next
Close #1
End Sub

Sub FileEdit(sFileName As String)
    Dim iSource As Long
    Dim iTarget As Long
    Dim sLine As String
    Dim sTmpFile As String
    iSource = FreeFile
    Open sFileName For Input As #iSource
        sTmpFile = Left(sFileName, InStrRev(sFileName, ".")) & "t~"
        iTarget = FreeFile
        Open sTmpFile For Output As #iTarget
            Do Until EOF(iSource)
                Line Input #iSource, sLine
                Select Case sLine
                Case "bad_condition1"
                Case "bad_condition2"
                '....
                Case Else
                    Print #iTarget, sLine
                End Select
            Loop
        Close #iTarget
    Close #iSource
    Kill sFileName
    Name sTmpFile As sFileName
End Sub

Option Explicit
 
Private Sub Form_Load()
    Dim i&, j&, a$(), aa$(), fl$
    ChDir Environ("SystemDrive")
    With CreateObject("scripting.filesystemobject")
        While Not .FileExists(fl): fl = InputBox("Введите правильный путь к файлу", , "\TIME\hours.txt"): Wend
        a = Split(.OpenTextFile(fl).ReadAll, vbCrLf): If UBound(a) = 0 Then MsgBox "Пусто.": End
        While j < 1 Or j > UBound(a) + 1: j = Val(InputBox("Укажи строчку удаления от 1 до " & UBound(a) + 1, , 0)): Wend
        If MsgBox("Строчка:" & vbLf & Left(a(j - 1), 10) & "..." & vbLf & "Будем удалять ?", 68) = vbNo Then End
        ReDim aa$(UBound(a) - 1)
        For i = 0 To UBound(a) - 1: aa(i - Abs(i >= j)) = a(i): Next
        .CreateTextFile(fl).Write Join(aa, vbCrLf)
        MsgBox "Строчка " & j & " успешно удалена, диалог окончен." & vbLf & "Досвидания."
    End With
    End
End Sub

Open "C:\TIME\hours.txt" For Input As #1
Dim S As String
While Not EOF(1)
N = N + 1
Input #1, S
St(N) = S
Wend
Close #1
 
Open "C:\TIME\hours.txt" For Output As #1
For i = 1 To 100
If i <> Val(Label1) Then
Print #1, St(i)
End If
 
Next
Close #1
End Sub
 
Private Sub Form_Load()
 
Open "C:\TIME\hours.txt" For Output As #1
For i = 1 To 100
Print #1, "" & i
Next
Close #1

Option Explicit
Dim ff&, v
 
Private Sub Form_Click()
    Dim i&
    ff = FreeFile
    Open "\TIME\hours.txt" For Input As #ff
    ReDim st$(1 To 1)
    While Not EOF(ff)
        i = i + 1
        If i > UBound(st) Then ReDim Preserve st(1 To i * 2)
        Input #ff, st(i)
    Wend
    Close #ff
    ReDim Preserve st(1 To i)
    ff = FreeFile
    Open "\TIME\hours.txt" For Output As #ff
    For i = 1 To UBound(st)
        If i <> 2 Then ' Убераем вторую строку
            Print #ff, st(i)
        End If
    Next
    Close #ff
End Sub
 
Private Sub Form_Load()
    ChDir Environ("systemdrive")
    If Len(Dir("\TIME", vbDirectory)) = 0 Then MkDir "\TIME"
    ff = FreeFile
    'Строчки ниже можно закоментировать если не нужно заполнять файл hours.txt
    Open "\TIME\hours.txt" For Output As #ff
    For Each v In Split("Удалить определенную строку в txt файле visual basic 6")
        Print #ff, v
    Next
    Close #ff
End Sub

Удалить
определенную 
строку
в
txt
файле
visual
basic
6

Удалить
строку
в
txt
файле
visual
basic
6

Sub RemoveLine(sFileName As String, iLineNumber As Long)
    Dim iSource As Long
    Dim iTarget As Long
    Dim iLineCount As Long
    Dim sLine As String
    Dim sTmpFile As String
    If Dir(sFileName) = "" Then
        MsgBox "Файл " & sFileName & " не обнаружен."
        Exit Sub
    End If
    iSource = FreeFile
    Open sFileName For Input As #iSource
        sTmpFile = Left(sFileName, InStrRev(sFileName, ".")) & "t~"
        iTarget = FreeFile
        Open sTmpFile For Output As #iTarget
            Do Until EOF(iSource)
                Line Input #iSource, sLine
                iLineCount = iLineCount + 1
                If iLineCount <> iLineNumber Then Print #iTarget, sLine
            Loop
        Close #iTarget
    Close #iSource
    Kill sFileName
    Name sTmpFile As sFileName
End Sub
 
Sub CallingForTest() 'пример работы программы
    RemoveLine "c:\TIME\hours.txt", 10  'число 10 это номер удаляемой строки
End Sub

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_BEGIN = 0
 
'::: Создание тестового файла
 
Sub A1()
    HomeDir$ = ThisWorkbook.Path
    fo% = FreeFile
    Open HomeDir$ + "\f1.txt" For Output As #fo%
    For i% = 1 To 200
        Print #fo%, "Строка - " & CStr(i%)
    Next i%
    Print #fo%, "***"
    Close #fo%
End Sub
 
'::: Удаление строки с номером N
 
Sub A2()
Dim Flg As Boolean
    HomeDir$ = ThisWorkbook.Path
    Fname$ = HomeDir$ + "\f1.txt"
    fb% = FreeFile
    Open Fname$ For Binary Access Read Write As #fb%
    LF& = LOF(fb%) ' исходная длина
    N% = 99 ' номер удаляемой строки
    Buf$ = Space$(200)
    iii% = 1
    Flg = False
    Do
      Buf$ = Space$(200)
      PT& = Loc(fb%) + 1
      Get #fb%, , Buf$
      Do
         If iii% = N% Then
            Seek #fb%, PT&
            Buf$ = Space$(200)
            Get #fb%, , Buf$
            k% = InStr(Buf$, Chr$(13))
            SZ& = k% + 1 '::: длина удаляемой строки
            PF& = PT& + k% + 1
            Do While (PF& < LF&)
               Seek #fb%, PF&
               Buf$ = Space$(200)
               Get #fb%, , Buf$
               Seek #fb%, PT&
               Put #fb%, , Buf$
               PT& = PT& + 200
               PF& = PF& + 200
            Loop
            Flg = True
            Exit Do
         End If
         k% = InStr(Buf$, Chr$(13))
         If k% = 0 Then Exit Do
         iii% = iii% + 1
         PT& = PT& + k% + 1
         Buf$ = Mid$(Buf$, k% + 2)
      Loop
    
      If Flg Then Exit Do
    
    Loop
    
    Close #fb%
 
    hf& = CreateFile(Fname$, GENERIC_WRITE, 0&, 0&, OPEN_EXISTING, 0&, 0&)
    newSize& = LF& - SZ&
    PP& = SetFilePointer(hf&, newSize&, 0&, FILE_BEGIN)
    Rc& = SetEndOfFile(hf&)
    Rc& = CloseHandle(hf&)
 
End Sub

    Dim i&
    For i = 1 To 10
        Print #ff, i
    Next

Private Sub Form_Load()
    ChDir Environ("systemdrive")
    If Len(Dir("\TIME", vbDirectory)) = 0 Then MkDir "\TIME"
    ff = FreeFile
     Dim i&
  Open "C:\TIME\hours.txt" For Output As #ff
    For i = 1 To UBound(St)
        Print #ff, i
    Next
    Close #ff
End Sub

Sub RemoveLine2(sFileName As String, iLineNumber As Long)
    On Error GoTo M
    Dim iSource As Long
    Dim iTarget As Long
    Dim iLineCount As Long
    Dim i As Long
    Dim sLine As String
    Dim sTmpFile As String
    If Dir(sFileName) = "" Then
        MsgBox "Файл " & sFileName & " не существует."
        Exit Sub
    End If
    iSource = FreeFile
    Open sFileName For Input As #iSource
        sTmpFile = Left(sFileName, InStrRev(sFileName, ".")) & "t~"
        iTarget = FreeFile
        Open sTmpFile For Output As #iTarget
            Do Until EOF(iSource)
                Input #iSource, i, sLine
                iLineCount = iLineCount + 1
                If i = iLineNumber Then
                    iLineCount = iLineCount - 1
                Else
                    sLine = CStr(iLineCount) & Chr(32) & sLine
                    Print #iTarget, sLine
                End If
            Loop
        Close #iTarget
    Close #iSource
    Kill sFileName
    Name sTmpFile As sFileName
    Exit Sub
M:
    MsgBox "Sorry, on open of the " & sFileName & " unforeseen error occured."
End Sub
 
 
 
Sub CallingForTest() 'пример работы программы
    RemoveLine2 "c:\TIME\hours.txt", 10  'число 10 это номер удаляемой строки
End Sub
 
Sub NumberLine(sFileName As String)
    Dim iSource As Long
    Dim iTarget As Long
    Dim iLineCount As Long
    Dim sLine As String
    Dim sTmpFile As String
    If Dir(sFileName) = "" Then
        MsgBox "Файл " & sFileName & " не существует."
        Exit Sub
    End If
    iSource = FreeFile
    Open sFileName For Input As #iSource
        sTmpFile = Left(sFileName, InStrRev(sFileName, ".")) & "t~"
        iTarget = FreeFile
        Open sTmpFile For Output As #iTarget
            Do Until EOF(iSource)
                Line Input #iSource, sLine
                iLineCount = iLineCount + 1
                sLine = CStr(iLineCount) & Chr(32) & sLine
                Print #iTarget, sLine
            Loop
        Close #iTarget
    Close #iSource
    Kill sFileName
    Name sTmpFile As sFileName
End Sub

Private Sub Command1_Click()
Dim St(10) As String
Open "C:\TIME\hours.txt" For Input As #1
    Dim S As String
    While Not EOF(1)
        N = N + 1
        Input #1, S
        St(N) = S
    Wend
Close #1
 
Open "C:\TIME\hours.txt" For Output As #1
    For i = 1 To 10
        If i <> Val(Label1) Then
            Print #1, St(i)
        End If
    
    Next
Close #1
End Sub
 
Private Sub Form_Load()
 
Open "C:\TIME\hours.txt" For Output As #1
For i = 1 To 10
    Print #1, "" & i
Next
Close #1
End Sub

Option Explicit
 
 
Private Sub Form_Load()
    Dim fl$, ff&, i&
    ChDir Environ("systemdrive")
    If Len(Dir("\TIME", vbDirectory)) = 0 Then MkDir "\TIME"
    
    fl = "\TIME\hours.txt"
    'Строчки ниже можно закоментировать если не нужно заполнять файл hours.txt
    
    If Len(Dir(fl)) = 0 Then
        '
        'Если файла совсем нет.. создаем и пишем туда 10 строчек
        '
        ff = FreeFile
        Open fl For Output As #ff
        For i = 1 To 10
            Print #ff, CStr(i)
        Next
        Close #ff
    End If
    '
    'Теперь если надо добавить еще строку то ...
    '
    ff = FreeFile
    Open fl For Binary As #ff
    Put #ff, LOF(ff) + 1, "[Новая строчка]" & vbCrLf
    Close ff
End Sub

Private LinesCount As Long

LinesCount = 'новое количество строк

For i = 1 To LinesCount

Option Explicit
Dim ff&, v
Private Sub Command1_Click()
    Dim i&
    ff = FreeFile
    Open "C:\TIME\hours.txt" For Input As #ff
    ReDim St$(1 To 1)
    While Not EOF(ff)
        i = i + 1
        If i > UBound(St) Then ReDim Preserve St(1 To i * 2)
        Input #ff, St(i)
    Wend
    Close #ff
    ReDim Preserve St(1 To i)
    ff = FreeFile
    Open "C:\TIME\hours.txt" For Output As #ff
    For i = 1 To UBound(St)
        If i <> Val(Label1) Then
            Print #ff, St(i)
        End If
    Next
    Close #ff
End Sub
Private Sub Form_Load()
Dim ff&
Dim i&
ff = FreeFile
Open "C:\TIME\hours.txt" For Output As #ff
ReDim St$(1 To 1)
    While Not EOF(ff)
        i = i + 1
        If i > UBound(St) Then ReDim Preserve St(1 To i * 2)
For i = 1 To UBound(St)
    Print #1, St(i) 
Next
  Wend
Close #ff
End Sub