excel vba move each text file to a new directory using the file name?

Question

i am using the following vba code to import all my text files onto a new row in excel. This bit works fine, the next thing I want to do is once this has imported the text files, I want each text file to be moved from one directory 'Z:\NS\Unactioned\' to another directory called Actioned 'Z:\NS\Actioned\&Filename\'.

And within that folder create a folder for each of the text files from the filename (minus the file extension) where i can then place each text file in the corresponding folder.

So if I had 3 .txt files in my folder Unactioned:

1.txt
2.txt
3.txt

then each txt file would be moved like so:

Actioned/1/1.txt
Actioned/2/2.txt
Actioned/3/3.txt

Can someone please show me how I would do this? Thanks

Code:

Sub Import_All_Text_Files_2007()

    Dim nxt_row As Long

     'Change Path
    Const strPath As String = "Z:\NS\Unactioned\"
    Dim strExtension As String

     'Stop Screen Flickering
    Application.ScreenUpdating = False

    ChDir strPath

     'Change extension
    strExtension = Dir(strPath & "*.txt")

    Do While strExtension <> ""


         'Sets Row Number for Data to Begin
        If Range("C1").Value = "" Then
  nxt_row = 1
Else
  If Range("C2").Value = "" Then
    nxt_row = 2
  Else
     nxt_row = Range("C1").End(xlDown).Offset(1).Row
  End If
End If

         'Below is from a recorded macro importing a text file
        FileNum = FreeFile()
curCol = 3
Open strPath & strExtension For Input As #FileNum
While Not EOF(FileNum)
    Line Input #FileNum, DataLine
    ActiveSheet.Cells(nxt_row, curCol) = DataLine
    curCol = curCol + 1
Wend
Close #FileNum

        strExtension = Dir
    Loop




    Dim d As String, ext, x
Dim srcPath As String, destPath As String, srcFile As String
srcPath = "Z:\NS\Unactioned\"
destPath = "Z:\NS\Actioned\" & srcFile & "\"
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


    Application.ScreenUpdating = True



End Sub

Answer 1

You misplaced destPath so it wasn't filled with the document name. Forgot to create destination directory (with MKDir) and the arguments of the last d=Dir statement

Try this (works for me) :

Sub Import_All_Text_Files_2007()
Dim d As String, ext, x
Dim srcPath As String, destPath As String, srcFile As String
Dim strExtension As String
Dim nxt_row As Long

'Change Path
Const strPath As String = "Z:\NS\Unactioned\"

'Stop Screen Flickering
Application.ScreenUpdating = False

ChDir strPath

'Change extension
strExtension = Dir(strPath & "*.txt")

Do While strExtension <> ""
    'Sets Row Number for Data to Begin
    If Range("C" & Rows.Count).End(xlUp).Offset(1).Row >= 5 Then
        nxt_row = Range("C" & Rows.Count).End(xlUp).Offset(1).Row
    Else
        nxt_row = 5
    End If

    'Below is from a recorded macro importing a text file
    FileNum = FreeFile()
    curCol = 3
    Open strPath & strExtension For Input As #FileNum
    While Not EOF(FileNum)
        Line Input #FileNum, DataLine
        ActiveSheet.Cells(nxt_row, curCol) = DataLine
        curCol = curCol + 1
    Wend
    Close #FileNum

    strExtension = Dir
Loop


srcPath = "Z:\NS\Unactioned\"
ext = Array("*.txt", "*.xls")

For Each x In ext
    d = Dir(srcPath & x)
    Do While d <> ""
        srcFile = srcPath & d
        destPath = "Z:\NS\Actioned\" & Left(d, Len(d) - 4) & "\"
        If Dir(destPath, 16) = "" Then MkDir (destPath)
        FileCopy srcFile, destPath & d
        Kill srcFile
        d = Dir(srcPath & x)
    Loop
Next x

Application.ScreenUpdating = True

End Sub