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使用文件名将每个文本文件移动到一个新目录？

1 个答案: