excel vba将每个文本文件移动到一个新的目录使用文件名？

我正在使用以下vba代码将所有文本文件导入到Excel中的新行。 这个位工作正常，接下来我想要做的就是导入文本文件，我希望每个文本文件从一个目录'Z:\NS\Unactioned\'到另一个名为“动作'Z:\NS\Actioned\&Filename\'目录中'Z:\NS\Actioned\&Filename\' 。

并在该文件夹中创build一个文件夹从每个文件的文件名（减去文件扩展名），然后我可以将每个文本文件放在相应的文件夹。

所以，如果我的文件夹中有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因此没有填充文档名称。 忘记创build目标目录（使用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