将字符串插入文本文件中的特定行

Question

我有一个行中有字符串的 Excel 表。 我有一个txt文件。 我已经有了要插入字符串的特定行数。

但是当我使用“写”时，它会删除所有内容，然后插入字符串。

如何在文本文件的特定行中插入字符串？我将使用循环来打开和关闭所有 txt 文件。

代码有效。只需要将字符串放入txt文件中。 p.s 注释是希伯来语。

Sub SearchTextFile()


'--------------------------------------------------------------------------------------------------úçéìú øéöú ÷åã
    Dim Start, Finish, TotalTime As Date

    Start = Timer

'--------------------------------------------------------------------------------------------------áéèåì çéùåáéí åòãëåðé îñê åäúøàåú
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False

'--------------------------------------------------------------------------------------------------äçæøú çéùåáéí åòãëåðé îñê åäúøàåú
    'Application.Calculation = xlCalculationAutomatic
    'Application.ScreenUpdating = True
    'Application.DisplayAlerts = True
    'Application.AskToUpdateLinks = True


    Dim strLine1, strLine2, strSearch1, strSearch2, Mid1, Mid2 As String
    Dim i, j, z, h As Integer
    Dim x, LineCount1, LineCount2 As Long
    Dim blnFound As Boolean

    x = 2
    LineCount1 = 0
    h = 0
    Do Until IsEmpty(Cells(x, 2))

        myFileCOMPANY = "L:\" & Cells(x, 2) & "\COMPANY.bat" 'áãé÷ä øàùåðéí äàí îñôø äçáøä ÷ééí áëìì

        If Not Dir(myFileCOMPANY) = "" Then 'àí ìà øé÷

           strFileName = "L:\" & Cells(x, 2) & "\COMPANY.bat" 'ðúéá - àéôä ìçôù

           strSearch1 = Cells(x, 7)  'îä ìçôù
           strSearch1 = "If Exist Dfile" & Format(strSearch1, "000") 'ùéðåé ôåøîè

           i = FreeFile

           On Error Resume Next
           Open strFileName For Input As #i

           Do While Not EOF(i)

               LineCount1 = LineCount1 + 1
               Line Input #i, strLine1

               If InStr(1, strLine1, strSearch1, vbBinaryCompare) > 0 Then 'äáéã÷ä òöîä äàí äè÷ñè ùîçôùéí ÷ééí áùåøä äæå

                     strSearch2 = "pz-"

                     Line Input #i, strLine2

                         For j = 1 To 4
                         If InStr(1, strLine2, strSearch2, vbBinaryCompare) + 1 > 0 Then 'äáéã÷ä òöîä äàí äè÷ñè ùîçôùéí ÷ééí áùåøä äæå

                             Cells(x, 11) = Cells(x, 2) 'îñôø çáøä
                             Cells(x, 12) = Format(Cells(x, 7), "000") 'îñôø úú
                             Cells(x, 13) = LineCount1 + j 'îñôø ùåøä
                             blnFound = True
                             Cells(x, 14) = Len(strLine2) 'àåøê ùåøä
                             Cells(x, 15) = "1." & strSearch1 & "  2." & strSearch2 'úå ùàåúå çéôùå
                             Cells(x, 16) = strLine2 'è÷ñè áùåøä ìôðé
                             Mid1 = Mid(Cells(x, 16), Cells(x, 14) - 12, 5)
                             Cells(x, 17) = Cells(x, 16) & " " & Mid1 & Cells(x, 3) & ".pdf"

                                For z = 1 To 10 'áîéãä åéù òåã îàåúä äçáøä åàåúå äúú àæ ëàï äúåñôåú ëøèéñéí ðöáøéí
                                If Cells(x, 7) = Cells(x + z, 7) And Cells(x, 2) = Cells(x + z, 2) Then

                                     Cells(x + z, 16) = Cells(x + h, 17)
                                     Mid2 = Mid(Cells(x + z, 16), Cells(x, 14) - 12, 5)
                                     Cells(x + z, 17) = Cells(x + z, 16) & " " & Mid2 & Cells(x + z, 3) & ".pdf"
                                     h = h + 1
                                End If
                                Next z

                             Exit For



                        End If
                        Next j

                           Open myFileCOMPANY For Output As #i
                            Write #i, "dfgdfg" 'Cells(x + z, 17)

                Exit Do

                Else: Cells(x, 11) = Cells(x, 2)
                      Cells(x, 12) = Cells(x, 7)
                      Cells(x, 15) = "Dfile" & Format(Cells(x, 7), "000") & " not found"

               End If

           Loop

           Close #i

            LineCount1 = 0

            Else: Cells(x, 11) = "No folder number " & Cells(x, 2)

        End If
        x = x + h
        h = 0
        x = x + 1

    Loop


'--------------------------------------------------------------------------------------------------äçæøú çéùåáéí åòãëåðé îñê åäúøàåú
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True


'--------------------------------------------------------------------------------------------------æîï ñéåí øéöú ÷åã åçéùåá
    Finish = Timer
    TotalTime = Format((Finish - Start) / 86400, "hh:mm:ss")

    MsgBox ("äãå''ç îåëï" & vbNewLine & "æîï øéöú ÷åã: " & TotalTime)


End Sub

Answer 1

不确定您尝试了哪些代码。如果你包含你的代码会更容易。

您可以尝试使用：

If Application.Options.Overtype Then
        Application.Options.Overtype = False
    End If

如果您尝试在文档末尾添加一行，您可以使用以下代码：

Function WordAddEnd()
   Dim objWord As Object, objDoc As Object, objSelection As Object
   Dim endpoint As Integer, moveit As Integer
   Dim FileString As String


endpoint = 6
moveit = 0
FileString = "C:\location\folder\document.docx"
Set objWord = CreateObject("Word.Application")
Onerror resumenext   
'change error handling

Set objDoc = objWord.documents.Open(FileString)

Set objSelection = objWord.Selection

With objSelection
    .EndKey endpoint, moveit
'finds end point of document

    .typeparagraph     
'goes to next line (like pressing the enter key)

    .TypeText ("It's some text you wanted")
'your text here

End With
objWord.documents.Close

End Function

如果相关文档已打开，则会出现错误，因此您需要在此处进行一些错误处理。