Excel VBA拷贝特定文件到指定文件夹的方法

用Excel把文件从一个文件夹移动到另一个文件夹。如我们需要将文件夹“C:\FolderA”中的符合条件为扩展名是xls或xlsx，且文件名中不包含“Office中国”字符串的文件粘贴到“C:\FolderB”中。
在Excel中插入一个按钮，在按钮的单击事件中加入如下代码：PrivateSubCommandButton1_Click()
DimFsoAsObject
SetFso=CreateObject("Scripting.FileSystemObject")
Dimfs,f,f1,fc
OnErrorResumeNext
Setfs=CreateObject("scripting.filesystemobject")
Setf=fs.GetFolder("C:\FolderA")
Setfc=f.Files
IfErr.Number0Then
MsgBox"FromFolderOpenError!"&vbCrLf&Err.Description&vbCrLf
GoToErr
EndIf
OnErrorGoTo0
ForEachf1Infc
If(Right(f1,3)="xls"OrRight(f1,4)="xlsx")AndInStr(1,f1,"Office中国")0Then
MsgBox"FileCopyError!"&vbCrLf&Err.Description
GoToErr
EndIf
OnErrorGoTo0
EndIf
Next
MsgBox"FileCopyisover."
Err:
Setfs=Nothing
Setf=Nothing
Setf1=Nothing
Setfc=Nothing
SetFso=Nothing
EndSub
上面事件中用到了两个函数，具体代码如下：
GetFileName用来得到一个完整路径中的文件名（带扩展名）FunctionGetFileName(ByValsAsString)AsString
Dimsname()AsString
sname=Split(s,"\")
GetFileName=sname(UBound(sname))EndFunction
SetFolderPath用来将不是\结尾的路径后面加上\FunctionSetFolderPath(ByValpathAsString)AsString
IfRight(path,1)"\"Then
SetFolderPath=path&"\"
Else
SetFolderPath=path
EndIf
EndFunction
内容参考至：大大佐的博客园