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

I really hope someone can help with this. At the moment I am using vba to import each line of text from a text file into a new column on one row. And each time I run the function a new row of data is created below the previous.

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

Results:

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

So this all works fine and after I have imported the text from the file, the file is moved from my directory 'unactioned' to a directory called 'actioned'.

所以这一切都运行良好,在我从文件中导入文本后,文件从我的目录'unactioned'移动到名为'actioned'的目录。

So at the moment my code is not quite there yet, I am currently having to define the text file name so that I can import the data from the text file into my spreadsheet and again i am defining the text file name i want to move, this code will only currently work for 1 text file. However what i want to be able to do is if there are several text files in my folder 'unactioned', then i want to import each of these text files into a new row, and move all the text files we have just imported the data from to my folder 'actioned' at the same time

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

Here is my code:

这是我的代码:

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

please can someone show me how i would amend this code to do what i need it to do? Thanks in advance

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

2 个解决方案

#1

I would suggest breaking your code into multiple functions.

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

You can change the ImportFile method to not kill ALL files, but just the file it operates on, and then have it take a specific file to operate on one at a time. E.g.:

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

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

Then, here is another * post on how to iterate files in a folder

然后,这是另一个关于如何迭代文件夹中的文件的*帖子

So with a little adaptation you could have something like:

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

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

#2

I'd also break it down into functions:

我还将它分解为函数:

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

This will place all files into a collection:

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

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

This will ask you to select a folder:

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

' To Use    : vFolder = GetFolder()
'           : vFolder = GetFolder("S:\Bartrup-CookD\Customer Services Phone Reports")
Function GetFolder(Optional startFolder As Variant = -1) As Variant
    Dim fldr As FileDialog
    Dim vItem As Variant
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        If startFolder = -1 Then
            .InitialFileName = Application.DefaultFilePath
        Else
            If Right(startFolder, 1) <> "\" Then
                .InitialFileName = startFolder & "\"
            Else
                .InitialFileName = startFolder
            End If
        End If
        If .Show <> -1 Then GoTo NextCode
        vItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = vItem
    Set fldr = Nothing
End Function

This will move a file from folder A to folder B:

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

'----------------------------------------------------------------------
' MoveFile
'
'   Moves the file from FromFile to ToFile.
'   Returns True if it was successful.
'----------------------------------------------------------------------
Public Function MoveFile(FromFile As String, ToFile As String) As Boolean

    Dim objFSO As Object

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    On Error Resume Next
    objFSO.MoveFile FromFile, ToFile
    MoveFile = (Err.Number = 0)
    Err.Clear
End Function

#1