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

Question

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

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

如果我的文件夹中有 3 个 .txt 文件未操作：

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

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

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

excel

vba

move