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

我不熟悉VBA宏我希望宏创建一个文件夹（子文件夹），然后将所有文件移动到新创建的文件夹中

我的密码

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”，表示找不到路径

有人请帮忙……

试试这个：

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

选项显式
子创建_move2（）
'变量声明
物体的暗度
Dim curFile作为变量
Dim fromdir作为字符串
作为字符串的Dim todir
Dim fileExt作为字符串
fromdir=“C:\Users\chariab\Desktop\POL-POD AutoExp\Extracted Files\”
todir=“C:\NewFolder\POL&POD文件-”&格式（现在为“DD-MM-YYYY”）&“
fileExt=“xlsx”'移动具有文件扩展名的文件
'创建FSO对象
Set of so=CreateObject（“Scripting.FileSystemObject”）
'创建文件夹
MkDir todir
对于oFSO.GetFolder（fromdir）中的每个curFile.Files循环遍历fromdir中的每个文件
如果正确（CStr（curFile.name），len（fileExt））=fileExt，则“如果匹配，则移动文件”
Debug.Print“moving”&curFile.name
curFile.movetodir
如果结束
下一个curFile
如果是Dir（todir&“\*.”“&fileExt）”，则“检查并查看文件是否移动”
MsgBox“已将文件移动到”&todir
其他的
MsgBox“未移动任何文件”
如果结束
一组SO=零
端接头

flxt

是一个包含通配符的字符串。它需要是您使用

fname=Dir（fromdir&flxt）

获得的确切文件名，文件夹中有多个excel文件，因此我给了flxt=“*.xlsx”，然后您需要循环遍历它们-关于如何实现堆栈溢出的大量示例。请回答1这是否回答了您的问题？谢谢，@Gregorio_Allegri这太完美了。如果您不介意的话，请再看一个悬而未决的案例，我将不胜感激。如果可能的话，案例标题是“根据另一列中的值为一列的空白单元格着色”。如果可以，请提供帮助。再次感谢@Gregorio_Allegrialso我没有看到你提到的案例，你能链接吗？不，前面的一个很好。这段代码在“'Create Folder MkDir todir”行出现错误。案例/问题标题是“根据另一列中的值为一列的空白单元格着色”