Question

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

我的密码

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源：= fromdir＆flxt，目标：= 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文件移动到新创建的文件夹中

1 个答案: