excel - Excel宏将两个记事本中的数据附加到一个记事本中

Question

我想删除最后一行包含两个记事本的'*'，并通过excel宏将reaming数据附加到一个新的记事本中。

请大家帮帮我。我找不到任何建议。

Answer 1

使用@mehow 的建议，您可以使用以下代码：

' To get this to run, you'll need to reference Microsoft Scripting Runtime:
    ' Per http://stackoverflow.com/questions/3233203/how-do-i-use-filesystemobject-in-vba
    ' Within Excel you need to set a reference to the VB script run-time library. The relevant file is usually located at \Windows\System32\scrrun.dll
    ' To reference this file, load the Visual Basic Editor (ALT-F11)
    ' Select Tools - References from the drop-down menu
    ' A listbox of available references will be displayed
    ' Tick the check-box next to 'Microsoft Scripting Runtime'
    ' The full name and path of the scrrun.dll file will be displayed below the listbox
    ' Click on the OK button

Sub appFiles()
    'File path and names for each file
    Dim sFile1 As String
    Dim sFile2 As String
    Dim sFileLast As String
    'Search string
    Dim sSearchStr As String
    'Delimiter used to separate/join lines
    Dim sDL As String
    'If the final file already exists, should it overwrite the previous _
        contents (True) or append to the end of the file (False)
    Dim doOverwrite As Boolean
    'File contents
    Dim sMsg1 As String
    Dim sMsg2 As String
    Dim sMsgFinal As String

    sFile1 = "C:\Users\foobar\Desktop\foo.txt"
    sFile2 = "C:\Users\foobar\Desktop\foo2.txt"
    sFileLast = "C:\Users\foobar\Desktop\fooFinal.txt"
    sSearchStr = "*"
    sDL = Chr(13) & Chr(10)
    doOverwrite = True

    sMsg1 = appendLines(sFile1, sSearchStr, sDL)
    sMsg2 = appendLines(sFile2, sSearchStr, sDL)
    sMsgFinal = sMsg1 & sDL & sMsg2

    Call writeToFile(sMsgFinal, sFileLast, doOverwrite)
End Sub

Function appendLines(sFileName As String, sSearchStr As String, Optional sDL As String = " ") As String
    Dim oFSO As FileSystemObject
    Set oFSO = New FileSystemObject

    Dim oFS As TextStream
    Dim sStr As String
    Dim sMsg As String
    If oFSO.fileexists(sFileName) Then  'Check if file exists
        On Error GoTo Err

        Set oFS = oFSO.openTextFile(sFileName)
        'Read file
        Do While Not oFS.AtEndOfStream
            sStr = oFS.ReadLine
            If InStr(sStr, sSearchStr) Then
                appendLines = sMsg
            Else
                sMsg = sMsg & sStr & sDL
            End If
        Loop
        oFS.Close
    Else
        Call MsgBox("The file path (" & sFileName & ") is invalid", vbCritical)
    End If

    Set oFS = Nothing
    Set oFSO = Nothing
    Exit Function

Err:
    Call MsgBox("Error occurred while reading the file.", vbCritical)

    oFS.Close
    Set oFS = Nothing
    Set oFSO = Nothing
End Function

Sub writeToFile(sMsg As String, sFileName As String, Optional doOverwrite As Boolean = False)
    Dim oFSO As FileSystemObject
    Set oFSO = New FileSystemObject

    Dim oFS As TextStream

    On Error GoTo Err
    If oFSO.fileexists(sFileName) Then
        If doOverwrite Then
            Set oFS = oFSO.openTextFile(sFileName, ForWriting)
        Else
            Set oFS = oFSO.openTextFile(sFileName, ForAppending)
        End If
    Else
        Set oFS = oFSO.CreateTextFile(sFileName, True)
    End If

    Call oFS.write(sMsg)

    oFS.Close
    Set oFS = Nothing
    Set oFSO = Nothing
    Exit Sub

Err:
    Call MsgBox("Error occurred while writing to the file.", vbCritical)

    oFS.Close
    Set oFS = Nothing
    Set oFSO = Nothing
End Sub

您需要根据需要自定义 appFiles 例程，方法是为 sFile1、sFile2 和 sFileLast 提供文件名；您想要的搜索字符串到 sSearchStr（您提到使用“*”）；分隔行的分隔符（当前编写为使用回车符和换行符）；以及决定是否覆盖最终文件的参数（如果您发现自己使用同一个最终文件多次运行此文件）。

这是我在编写上述代码时使用的另一个链接：链接- 说明如何从宏中写入文件

希望这可以帮助。