Question

我真的希望有人可以帮忙解决这个问题。目前我正在使用vba将文本文件中的每一行文本导入到一行的新列中。每次运行该函数时，都会在前一个函数下创建一个新的数据行。

结果：

Row 1 (Showing Data from TextFile 1)
Column A     Column B           Column C
Data         Data               Data

Row 2 (Showing Data from TextFile 2)
Column A     Column B           Column C
Data         Data               Data

所以这一切都运行良好，在我从文件中导入文本后，文件将从我的目录中移出＆＃39; unactioned＆＃39;到名为＆＃39; actioned＆＃39;。

的目录

所以目前我的代码尚未完全存在，我目前不得不定义文本文件名，以便我可以将文本文件中的数据导入到我的电子表格中，然后再定义我想要的文本文件名要移动，此代码目前仅适用于1个文本文件。但是我想要做的是，如果我的文件夹中有多个文本文件＆＃39; unactioned＆＃39;，那么我想将这些文本文件中的每一个导入一个新行，并移动我们的所有文本文件刚刚将数据导入我的文件夹＆＃39; actioned＆＃39;同时

这是我的代码：

Sub ImportFile()

    Dim rowCount As Long

    rowCount = ActiveSheet.UsedRange.Rows.Count + 1

    If Cells(1, 1).Value = "" Then rowCount = 1


    Close #1
    Open "Y:\Incident Logs\Unactioned\INSC89JH.txt" For Input As #1
    A = 1
     Do While Not EOF(1)
            Line Input #1, TextLine
            Cells(rowCount, A) = TextLine
            A = A + 1
        Loop
    Close #1


 Dim d As String, ext, x
Dim srcPath As String, destPath As String, srcFile As String
srcPath = "Y:\Incident Logs\Unactioned\"
destPath = "Y:\Incident Logs\Actioned\"
ext = Array("*.txt", "*.xls")
For Each x In ext
    d = Dir(srcPath & x)
        Do While d <> ""
            srcFile = srcPath & d
            FileCopy srcFile, destPath & d
            Kill srcFile
            d = Dir
        Loop
Next


End Sub

请有人告诉我如何修改此代码以执行我需要它做的事情？提前致谢

Answer 1

我建议将代码分解为多个函数。

您可以将ImportFile方法更改为不杀死所有文件，而只删除它所操作的文件，然后让一个特定文件一次一个地运行。 E.g：

Sub ImportFile(directory As String, filename As String)
    Dim rowCount As Long
    rowCount = ActiveSheet.UsedRange.Rows.Count + 1
    If Cells(1, 1).Value = "" Then rowCount = 1

    Close #1
    Open directory & filename For Input As #1
    A = 1
     Do While Not EOF(1)
            Line Input #1, TextLine
            Cells(rowCount, A) = TextLine
            A = A + 1
        Loop
    Close #1

    'Move the file and delete it
    Dim srcPath As String, destPath As String
    srcPath = directory & filename
    destPath = "C:\Incident Logs\Actioned\" & filename
    FileCopy srcPath, destPath
    Kill srcPath
End Sub

然后，这是how to iterate files in a folder

上的另一个stackoverflow帖子

所以通过一些改编，你可以得到类似的东西：

Sub ImportAllFiles()
    ImportFilesWithExtension "*.txt"
    ImportFilesWithExtension "*.xls*"
End Sub

Sub ImportFilesWithExtension(extension As String)
    Dim StrFile As String, myDir As String
    myDir = "C:\Incident Logs\Unactioned\"
    StrFile = Dir(myDir & extension)
    Do While Len(StrFile) > 0
        ImportFile myDir, StrFile
        StrFile = Dir
    Loop
End Sub

Answer 2

我也将其细分为函数：

MultipleFailureException

这会将所有文件放入集合中：

ClassNotFoundException

这将要求您选择一个文件夹：

Sub ImportFile()

    Dim rLastCell As Range
    Dim vFolder As Variant
    Dim vFile As Variant
    Dim colFiles As Collection


    With ThisWorkbook.Worksheets("Sheet1") 'Note - update sheet name.

        'First find the last cell on the named sheet.
        Set rLastCell = .Cells.Find( _
            What:="*", _
            LookIn:=xlValues, _
            SearchDirection:=xlPrevious)

        If rLastCell Is Nothing Then
            'Set LastCell to A2.
            Set rLastCell = .Cells(2, 1)
        Else
            'Set LastCell to column A, last row + 1
            Set rLastCell = .Range(rLastCell.Row + 1, 1)
        End If

        vFolder = GetFolder()
        Set colFiles = New Collection

        EnumerateFiles vFolder, "\*.txt", colFiles

        For Each vFile In colFiles
            'Do stuff with the file.

            'Close the file and move it.
            MoveFile CStr(vFile), "S:\Bartrup-CookD\Text 1\" & Mid(vFile, InStrRev(vFile, "\") + 1, Len(vFile)) 'Note - update folder name.
        Next vFile

    End With

End Sub

这会将文件从文件夹A移动到文件夹B：

Sub EnumerateFiles(ByVal sDirectory As String, _
    ByVal sFileSpec As String, _
    ByRef cCollection As Collection)

    Dim sTemp As String

    sTemp = Dir$(sDirectory & sFileSpec)
    Do While Len(sTemp) > 0
        cCollection.Add sDirectory & "\" & sTemp
        sTemp = Dir$
    Loop
End Sub

Excel vba：导入多个文本文件，导入后移动文件？

2 个答案: