Excel VBA
Excel VBA拷贝特定文件到指定文件夹的方法
2017-09-04 16:35:15

用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

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