用Excel VBA拷贝特定文件到另一文件夹的方法

  假设我们需要将文件夹“C:\FolderA”中的符合下面条件的文件，拷贝到“C:\FolderB”中。

  拷贝条件：扩展名是xls或xlsx，并且文件名中不包含“OK”字样。

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

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, 'OK') <= 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 = NothingEnd 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 IfEnd Function