创建文件夹并将所有 xlsx 文件移动到新创建的文件夹中

Question

我是 VBA MACRO 的新手，我希望宏创建一个文件夹（子文件夹），然后将所有文件移动到新创建的文件夹中。

我的代码

Sub create_move()

'Variable declaration
    Dim sFolderName As String, sFolder As String
    Dim sFolderPath As String, oFSO As Object
    Dim fromdir As String
    Dim todir As String
    Dim flxt As String
    Dim fname As String
    Dim fso As Object
       
    'Main Folder
    sFolder = "C:\Main\" 'Main Folder where macro excel is present
    
    'Folder Name
    sFolderName = "POL & POD Files" & " " & "-" & " " & Format(Now, "DD-MM-YYYY")
    
    'Folder Path
    sFolderPath = "C:\NewFolder\" & sFolderName 'New Folder
        
    'Create FSO Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    'Create Folder
    MkDir sFolderPath
    
'Move files

fromdir = "C:\Users\chariab\Desktop\POL-POD AutoExp\Extracted Files\"

todir = "sFolderName" & "sFolderPath" ' Newly created folder name and path

flxt = "*.xlsx"

fname = Dir(fromdir & flxt)

 If Len(fname) = 0 Then
 MsgBox "All Excel Files Moved" & fromdir
 
Exit Sub
End If


Set fso = CreateObject("Scripting.FileSystemObject")

fso.MoveFile Source:=fromdir & flxt, Destination:=todir

End Sub

此宏创建文件夹但不移动其中的文件我收到运行时间错误 76 找不到路径。当我调试时，我在这一行 "fso.MoveFile Source:=fromdir & flxt, Destination:=todir"

上收到错误

我的想法是先创建一个新文件夹，为此我进行了初始编码以创建一个新文件夹，然后将文件移动到那个新创建的文件夹中，所以我给了“他们=变量名和路径我曾经创建文件夹”，但这不起作用这段代码正在创建新文件夹，但没有移动其中的文件，并在此行“fso.MoveFile Source:=fromdir & flxt, Destination:=todir”中出现错误说找不到路径。

Some1 请帮助....

Answer 1

试试这个：

Option Explicit

Sub create_move2()
    'Variable declaration
    Dim oFSO As Object
    Dim curFile As Variant
    Dim fromdir As String
    Dim todir As String
    Dim fileExt As String
           
    fromdir = "C:\Users\chariab\Desktop\POL-POD AutoExp\Extracted Files\"
    todir = "C:\NewFolder\POL & POD Files - " & Format(Now, "DD-MM-YYYY") & "\"

    fileExt = "xlsx"  'move files with file extension
            
    'Create FSO Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    'Create Folder
    MkDir todir
    
    For Each curFile In oFSO.GetFolder(fromdir).Files  'loop thru each file in fromdir

        
        If Right(CStr(curFile.name), len(fileExt)) = fileExt Then        'move file if it matches
            Debug.Print "moving " & curFile.name
            curFile.Move todir
        End If
    Next curFile
    
    If Dir(todir & "\*." & fileExt) <> "" Then 'check and see if files moved
        MsgBox "moved files to " & todir
    Else
        MsgBox "no files moved"
    End If
    
    Set oFSO = Nothing
    
End Sub

创建文件夹并将所有 xlsx 文件移动到新创建的文件夹中

Create folder and moves all the xlsx file in the newly created folder

vba

filesystemobject