时间戳

首页 > 解决方案 > 创建文件夹并移动新创建的文件夹中的所有 xlsx 文件

vba - 创建文件夹并移动新创建的文件夹中的所有 xlsx 文件

问题描述

我是 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”这一行中出现错误，提示找不到路径。

有人请帮忙....

标签： vbafilesystemobject

解决方案

尝试这个：

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

推荐阅读