Question

我真的不知道如何编程，但我编写了一些脚本来实现我想要的功能，但是我在最后一步失败了。

该脚本从，单元格B2，表单2中的文件目录打开.txt文件，并将其内容复制到excel（以及我不关心的记事本）。

但是，我有120个文件目录，我想这样做。目前我的脚本刚刚从单元格B2中获取目录，我在B列中有其余的119个目录，我运行脚本并删除行并重复，这有点辛苦。

我希望脚本自动运行B列中的所有120个文件。任何帮助表示赞赏！

    Option Explicit

Sub ReadTxtFile()
    Dim start As Date
    start = Now

    Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")

    Dim oFS As Object

   Dim filePath As String


    '''''Assign the Workbook File Name along with its Path

    filePath = Worksheets("Sheet2").Range("B2").Value
 MsgBox Worksheets("Sheet2").Range("B2").Value
    Dim arr(100000) As String
    Dim i As Long
    i = 0

    If oFSO.FileExists(filePath) Then
        On Error GoTo Err

        Set oFS = oFSO.OpenTextFile(filePath)
        Do While Not oFS.AtEndOfStream
            arr(i) = oFS.ReadLine
            i = i + 1
        Loop
        oFS.Close
    Else
        MsgBox "The file path is invalid.", vbCritical, vbNullString
        Exit Sub
    End If

   For i = LBound(arr) To UBound(arr)
    If InStr(1, arr(i), "Transmission", vbTextCompare) Then

        'Declare variables for the new output file
        Dim sOutputFileNameAndPath As String
        Dim FN As Integer
        sOutputFileNameAndPath = "C:\Users\nfraser\Documents\test\second.txt"
        FN = FreeFile

        'Open new output file
        Open sOutputFileNameAndPath For Output As #FN


        'While 'end of report' has not been found,
        'keep looping to print out contents starting from 'report'
        Do While InStr(1, arr(i), "Ancillary", vbTextCompare) = 0

            Debug.Print i + 1, arr(i)
            Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1
            Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i)

            'Print into new output file
            Print #FN, i + 1 & " " & arr(i)

            'increment count
            i = i + 1

        Loop

        'Print out the 'end of report' line as well
        Debug.Print i + 1, arr(i)
        Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1
        Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i)

        'Print 'end of report' line into new output file as well
        Print #FN, i + 1 & " " & arr(i)

        'close the new output file
        Close #FN

        'exit the 'For..Next' structure since 'end of report' has been found
        Exit For


    End If

Next

    Debug.Print DateDiff("s", start, Now)

Exit Sub



Err:
    MsgBox "Error while reading the file.", vbCritical, vbNullString
    oFS.Close
    Exit Sub

End Sub

Answer 1

您可以添加for... each循环，循环浏览当前选择中的所有单元格。这是模式：

Dim cCell as Range
For Each cCell in Selection
    'do stuff
Next cCell

现在，由于您在整个代码中更改了选择，因此您必须将选择内容存储在另一个变量中，例如： originalSelection然后循环遍历originalSelection中的单元格。否则，您的选择将在执行期间发生变化。

根据您的代码进行调整，我们最终得到以下信息......请注意：我将您的代码分为两种方法--- ReadTxtFiles和copyTo; ReadTxtFile() sub变得太长了。

Option Explicit

Sub ReadTxtFiles()
    Dim start As Date
    start = Now

    Dim oFS As Object
    Dim inputFilePath As String
    Dim outputFilePath As String
    Dim outputDirectory As String
    outputDirectory = "C:\Users\nfraser\Documents\test\"

    '''''Assign the Workbook File Name along with its Path
    Dim originalSelection As Range
    Dim cCell As Range
    Dim i As Integer

    Set originalSelection = Selection

    For Each cCell In originalSelection
        inputFilePath = cCell.Value
        outputFilePath = outputDirectory & i & ".txt"
        copyTo inputFilePath, outputFilePath
    Next cCell

    Debug.Print DateDiff("s", start, Now)

End Sub


Sub copyTo(inputPath As String, outputPath As String)
    Dim arr(100000) As String
    Dim i As Long
    Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject") 'late binding
    Dim oFS As Object
    i = 0

    If oFSO.FileExists(inputPath) Then
        On Error GoTo Err 'ensure oFS gets closed

        Set oFS = oFSO.OpenTextFile(inputPath)

        'read file contents into array
        Do While Not oFS.AtEndOfStream
            arr(i) = oFS.ReadLine
            i = i + 1
        Loop

        'close
        oFS.Close
    Else 'file didn't exist
        MsgBox "The file path is invalid.", vbCritical, vbNullString
        Exit Sub
    End If

    For i = LBound(arr) To UBound(arr)

        If InStr(1, arr(i), "Transmission", vbTextCompare) Then

            'Declare variables for the new output file
            Dim FN As Integer
            FN = FreeFile

            'Open new output file
            Open outputPath For Output As #FN

            'While 'end of report' has not been found,
            'keep looping to print out contents starting from 'report'
            Do While InStr(1, arr(i), "Ancillary", vbTextCompare) = 0

                Debug.Print i + 1, arr(i)
                Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1
                Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i)

                'Print into new output file
                Print #FN, i + 1 & " " & arr(i)

                'increment count
                i = i + 1

            Loop

            'Print out the 'end of report' line as well
            Debug.Print i + 1, arr(i)
            Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1
            Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i)

            'Print 'end of report' line into new output file as well
            Print #FN, i + 1 & " " & arr(i)

            'close the new output file
            Close #FN

            'exit the 'For..Next' structure since 'end of report' has been found
            Exit For
        End If
    Next
    Exit Sub

Err:
    MsgBox "Error while reading the file.", vbCritical, vbNullString
    oFS.Close
    Exit Sub
End Sub

Answer 2

要快速行动，请尝试以下方法：

更改此行：

filePath = Worksheets("Sheet2").Range("B2").Value

进入循环

Dim v As Variant, filepath As String
For Each v In Worksheets("Sheet2").Columns("B").SpecialCells(xlCellTypeConstants)
    filepath = v.Value
    debug.Print filePath
   .... ' remainder of your code

..然后转到Next行并在其后写下另一条Next行。

创建一个循环，直到脚本

2 个答案: