excel vba使用文件名將每個文本文件移動到新目錄？

Question

我正在使用以下vba代碼將所有文本文件導入到excel中的新行。這一點工作正常，我想要做的下一件事是一旦這已經導入文本文件，我希望每個文本文件從一個目錄'Z:\NS\Unactioned\'移動到另一個目錄稱爲動作'Z:\NS\Actioned\&Filename\'。

然後在該文件夾中爲文件名中的每個文本文件（減去文件擴展名）創建一個文件夾，然後我可以將每個文本文件放在相應的文件夾中。

所以，如果我有3個.txt文件夾我在Unactioned：

1.txt 
2.txt 
3.txt 

那麼每個txt文件將被移動，像這樣：

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

可有人請告訴我我該怎麼辦這個？由於

代碼：

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

你放錯地方的destPath所以沒有填充文檔名稱。 忘記了創建目標目錄（與MKDir）和最後d=Dir語句的參數

試試這個（爲我的作品）：

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