利用ExcelVBA文件夹-Excel VBA拷贝特定文件到指定文件夹的方法

用Excel把文件从一个文件夹移动到另一个文件夹。 

如我们需要将文件夹“C:FolderA”中的符合条件为扩展名是xls或xlsx，且文件名中不包含“Office中国”字符串的文件粘贴到“C:FolderB”中。

 在Excel中插入一个按钮，在按钮的单击事件中加入如下代码：

Private Sub CommandButton1_Click()

    Dim Fso As Object    
    Set Fso = CreateObject("Scripting.FileSystemObject")

    Dim fs, f, f1, fc    
    On Error Resume Next
    
    Set fs = CreateObject("scripting.filesystemobject")
    Set f = fs.GetFolder("C:FolderA")
    Set fc = f.Files
    
    If Err.Number <> 0 Then

        MsgBox "From Folder Open Error!" & vbCrLf & Err.Description & vbCrLf
        GoTo Err

    End If
    
    On Error GoTo 0


    For Each f1 In fc
        
        If (Right(f1, 3) = "xls" Or Right(f1, 4) = "xlsx") And InStr(1, f1, "Office中国") <= 0 Then        
            On Error Resume Next
                Fso.CopyFile f1, SetFolderPath("C:FolderB")) & GetFileName(f1)           
                If Err.Number <> 0 Then
                    MsgBox "File Copy Error!" & vbCrLf & Err.Description
                    GoTo Err
                End If
            On Error GoTo 0        
        End If        
    Next
    MsgBox "File Copy is over."

Err:

    Set fs = Nothing
    Set f = Nothing
    Set f1 = Nothing
    Set fc = Nothing
    Set Fso = Nothing

End Sub

上面事件中用到了两个函数，具体代码如下：
GetFileName用来得到一个完整路径中的文件名（带扩展名）

Function GetFileName(ByVal s As String) As String
    Dim sname() As String
sname = Split(s, "")
GetFileName = sname(UBound(sname))End Function

SetFolderPath用来将不是结尾的路径后面加上

Function SetFolderPath(ByVal path As String) As String
    If Right(path, 1) <> "" Then
        SetFolderPath = path & ""
    Else
        SetFolderPath = path
    End If
End Function

内容参考至：大大佐的博客园