Excel vba: Import multiple text files, and move files after import?

Question

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.

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'.

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

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

score 0 · Answer 1 · edited May 23 '17 at 12:06

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.:

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 stackoverflow 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

score 0 · Answer 2 · answered May 05 '15 at 16:40

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:

'----------------------------------------------------------------------
' 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

Excel vba: Import multiple text files, and move files after import?

2 Answers2