Excel 将所有pdf文件移动到新文件夹

我想将所有扩展名为pdf的文件复制到一个新文件夹（从单元格中取名称）

我创建了以下代码：

公共子MyFileprojectTF（）
暗起始路径为字符串
将myName设置为字符串
Dim SourceFileName作为字符串，DestinFileName作为字符串
作为对象的Dim FSOFile
作为对象的模糊文件夹
FolderName=“C:\Users\320105013\Desktop\DXR\”
设置FSOLibrary=CreateObject（“Scripting.FileSystemObject”）
设置FSOFolder=FSOLibrary.getfolder（FolderName）
设置FSOFile=FSOFolder.Files
设置fso=CreateObject（“Scripting.Filesystemobject”）
startPath=“C:\Users\320105013\Desktop\DXR测试文件”
myName=ActiveSheet.Range（“B3”）.Text“根据需要更改为包含文件夹标题的单元格
如果myName=vbNullString，则myName=“测试”
名称为字符串的Dim FolderPath
folderPathWithName=startPath&Application.PathSeparator&myName
如果Dir（folderPathWithName，vbDirectory）=vbNullString，则
MkDir folderPathWithName
其他的
MsgBox“文件夹已存在”
出口接头
如果结束
ActiveWorkbook.FollowHyperlink起始路径和myName
SourceFileName=“C:\Users\320105013\Desktop\DXR\”&（FSOFile）
DestinFileName=startPath&myName&“\”
对于FSOFile中的每个FSOFile
如果FSOFile像“*.pdf”，那么
FSOFile.MoveFile源：=源文件名，目标：=目标文件名
如果结束
下一个
端接头

我得到以下错误：

“参数数目错误”

---

在

FSOFile.MoveFile Source:=SourceFileName，Destination:=DestinFileName

上，您将FSOFile作为两个不同的变量使用两次。。。请参阅我添加的3条评论

Public Sub MyFileprojectTF()

Dim startPath As String
Dim myName As String
Dim SourceFileName As String, DestinFileName As String
Dim FSOFile As Object
Dim FSOFiles As Object ' ADD THIS
Dim FSOFolder As Object

FolderName = "C:\Users\320105013\Desktop\DXR\"

Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.getfolder(FolderName)
Set FSOFiles = FSOFolder.Files ' CHANGE THIS
Set fso = CreateObject("Scripting.Filesystemobject")
 
startPath = "C:\Users\320105013\Desktop\DXR Test files\"
myName = ActiveSheet.Range("B3").Text        ' Change as required to cell holding the folder title

If myName = vbNullString Then myName = "Testing"

Dim folderPathWithName As String
folderPathWithName = startPath & Application.PathSeparator & myName

If Dir(folderPathWithName, vbDirectory) = vbNullString Then
    MkDir folderPathWithName
Else
   MsgBox "Folder already exists"
   Exit Sub
End If

ActiveWorkbook.FollowHyperlink startPath & myName

SourceFileName = "C:\Users\320105013\Desktop\DXR\" & (FSOFile)
DestinFileName = startPath & myName & "\"
 
    For Each FSOFile In FSOFiles ' CHANGE THIS
        If FSOFile Like "*.pdf" Then
        FSOFile.MoveFile Source:=SourceFileName, Destination:=DestinFileName
    End If
    Next
 End Sub

---

好的，我把它改成下面的 但在FSOFile.MoveFile Source:=SourceFileName，Destination:=DestinFileName行上获取错误消息“对象不支持…”

Public Sub MyFileprojectTF()

Dim startPath As String
Dim myName As String
Dim SourceFileName As String, DestinFileName As String
Dim FSOFile As Object
Dim FSOFiles As Object
Dim FSOFolder As Object

FolderName = "C:\Users\320105013\Desktop\DXR\"

Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.getfolder(FolderName)
Set FSOFiles = FSOFolder.Files
Set fso = CreateObject("Scripting.Filesystemobject")
 
startPath = "C:\Users\320105013\Desktop\DXR Test files\"
myName = ActiveSheet.Range("B3").Text        ' Change as required to cell holding the folder title

If myName = vbNullString Then myName = "Testing"

Dim folderPathWithName As String
folderPathWithName = startPath & Application.PathSeparator & myName

If Dir(folderPathWithName, vbDirectory) = vbNullString Then
    MkDir folderPathWithName
Else
   MsgBox "Folder already exists"
   Exit Sub
End If

ActiveWorkbook.FollowHyperlink startPath & myName

SourceFileName = "C:\Users\320105013\Desktop\DXR\"
    DestinFileName = startPath & myName & "\"
     
    For Each FSOFile In FSOFiles
        If FSOFile Like "*.pdf" Then
        FSOFile.MoveFile Source:=SourceFileName, Destination:=DestinFileName
        End If
    Next
 End Sub

将文件移动到文件夹

• 使用是最简单的方法

代码

Option Explicit

Public Sub MyFileprojectTF()
    
    Const sFolderPath As String = "C:\Users\320105013\Desktop\DXR\"
    Const dStartPath As String = "C:\Users\320105013\Desktop\DXR Test files\"
    Const ExtensionPattern As String = "*.pdf"
    Dim pSep As String: pSep = Application.PathSeparator
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dFolderName As String
    Dim dFolderPath As String
    dFolderName = wb.Worksheets("Sheet1").Range("B3").Value
    If dFolderName = vbNullString Then
        dFolderName = "Testing"
    End If
    dFolderPath = dStartPath & pSep & dFolderName
    
    If Dir(dFolderPath, vbDirectory) = vbNullString Then
        If Dir(sFolderPath & pSep & ExtensionPattern) <> vbNullString Then
            MkDir dFolderPath
            With CreateObject("Scripting.FileSystemObject")
                .MoveFile Source:=sFolderPath & pSep & ExtensionPattern, _
                    Destination:=dFolderPath
                wb.FollowHyperlink dFolderPath
            End With
        Else
            MsgBox "No matching files found in folder '" & sFolderPath & "'."
        End If
    Else
        MsgBox "Folder '" & dFolderPath & "' already exists"
    End If
    
End Sub

选项显式
公共子MyFileprojectTF（）
Const sFolderPath As String=“C:\Users\320105013\Desktop\DXR\”
Const dStartPath As String=“C:\Users\320105013\Desktop\DXR测试文件”
常量扩展模式为字符串=“*.pdf”
将pSep设置为字符串：pSep=Application.PathSeparator
将wb设置为工作簿：设置wb=ThisWorkbook
Dim dFolderName作为字符串
将dFolderPath设置为字符串
dFolderName=wb.工作表（“表1”）.范围（“B3”）.值
如果dFolderName=vbNullString，则
dFolderName=“测试”
如果结束
dFolderPath=dStartPath&pSep&dFolderName
如果Dir（dFolderPath，vbDirectory）=vbNullString，则
如果Dir（sFolderPath&pSep&ExtensionPattern）vbNullString，则
MkDir-dFolderPath
使用CreateObject（“Scripting.FileSystemObject”）
.MoveFile源：=sFolderPath&pSep&ExtensionPattern_
目标：=dFolderPath
wb.FollowHyperlink dFolderPath
以
其他的
MsgBox“在文件夹“”和文件夹路径中找不到匹配的文件。”
如果结束
其他的
MsgBox“文件夹”'&dFolderPath&“已存在”
如果结束
端接头

是否

ActiveWorkbook

和

ActiveSheet

是包含代码的同一工作簿的“部分”？

ActiveSheet

的名称是什么？是的。。带ActiveSheet的activeworkbook将需要一段时间。同时，如果您可以提供

ActiveSheet

名称，因为没有必要不使用其名称。由于这是我创建的测试文件，活动工作表的名称为：“Sheet1”，仅用于添加；我在单元格（sheet1）中输入一个值，并使用该单元格的名称创建一个新文件夹（sheet1）