VBA 操作文件相关的技巧总结
'适用于知识点六的API代码
Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
'知识点一：Path，返回当前工作簿路径
'测试代码如下:
Sub getpath()
'定义mypath为字符串
Dim mypath As String
'把当前文件路径赋予给mypath，注意thisworkbook.path的使用
mypath = ThisWorkbook.Path
'显示路径
MsgBox mypath
End Sub
'知识点二：利用当前路径选择性打开当前文件夹中某xlsx文件
Sub myfile()
'定义mypath为字符串
Dim mypath As String
' 指定路径
mypath = ThisWorkbook.Path
'打开指定路径的A工作簿
Workbooks.Open mypath & "\A.xlsx"
End Sub
'知识点三:返回当前文件夹的除了“文件操作”外其他所有xlsx文件名
Sub GetAllFileName()
'定义MyDir为字符串
Dim MyDir As String
'返回当前工作簿路径的Excel文件名称
MyDir = Dir(ThisWorkbook.Path & "\*.xlsx")
'把MyFile赋予A1
[A1] = "MyFile"
'******************************************
Do
'需要列出的文件名不包含当前的“文件操作”的Excel文件，使用Not...Like 来判断
If Not MyDir Like "*文件操作*" Then
'如果不存在，则逐个填入当前文件夹中的Excel文件名称
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = MyDir
'退出If判断
End If
'返回匹配路径的第一个文件名称
MyDir = Dir
'避免错误发生，设置循环终止条件为Len(MyDir)=0，即判断文件名是否为空
Loop Until Len(MyDir) = 0
'******************************************
End Sub
'知识点四:批量删除文件夹内所有类型文件
Sub 批量删除文件()
'定义变量
Dim fso, fld, fd, F
'调用Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
'返回一个和指定路径中文件夹相对应的FSO文件夹对象
Set fld = fso.getfolder(ThisWorkbook.Path & "\")
'循环每个文件夹并删除
For Each fd In fld.subfolders
fd.Delete
Next
'除了本工作簿文件外，循环其他每个文件并删除
For Each F In fld.Files
If F.Name <> ThisWorkbook.Name Then F.Delete
Next
End Sub
'知识点五:判断指定文件是否存在
Sub FileExist1()
'如果当前路径下的B文件的文件名不为空，则存在，否则不存在
If Dir(ThisWorkbook.Path & "\B.xlsx") <> "" Then
MsgBox "B文件存在!"
Else
MsgBox "B文件不存在!"
End If
End Sub
'知识点六:判断指定文件是否存在（API函数)
'*************API代码判断存在*******************************************************************
'Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Sub FileExist2()
'调用了PathFileExists这个API函数判断
If CBool(PathFileExists(ThisWorkbook.Path & "\B.xlsx")) Then
MsgBox "B文件存在!"
Else
MsgBox "B文件不存在!"
End If
End Sub
'PathFileExists 既可以判断本地文件是否存在，又可以判断远程电脑上的文件是否存在。函数返回值是个Long型变量，返回两个值0,1。1表示文件存在(True),0表示文件不存在(False)
'*************API代码判断存在*******************************************************************
'知识点七:判断指定文件是否存在（Scripting.FileSystemObject法)
Sub FileExist3()
'定义变量fs
Dim fs
'调用Scripting.FileSystemObject
Set fs = CreateObject("Scripting.FileSystemObject")
'利用FileExists功能判断
If fs.FileExists(ThisWorkbook.Path & "\B.xlsx") = True Then
MsgBox "B文件存在!"
Else
MsgBox "B文件不存在!"
End If
End Sub
'知识点八:列出指定路径所有子文件夹名称
Sub GetAllFolderlist()
'定义变量fs、fld、fd
Dim fs, fld, fd
'定义i为长整型
Dim i As Long
'初始化i变量
i = 0
'调用Scripting.FileSystemObject
Set fs = CreateObject("Scripting.filesystemobject")
'返回一个和指定路径中文件夹相对应的FSO文件夹对象
Set fld = fs.getfolder(ThisWorkbook.Path & "\")
'循环每个文件夹
For Each fd In fld.subfolders
'把文件夹名称赋予B列
Cells(i + 1, 2) = fd.Name
'使用累加器
i = i + 1
Next
End Sub
'知识点九:获取文件夹大小
Sub GetF()
'定义变量fs、fld、fd
Dim fs, fld, fd
'定义i为长整型
Dim i As Long
'初始化i变量
i = 0
'调用Scripting.FileSystemObject
Set fs = CreateObject("Scripting.filesystemobject")
'返回一个和指定路径中文件夹相对应的FSO文件夹对象
Set fld = fs.getfolder(ThisWorkbook.Path & "\")
'循环每个文件夹
For Each fd In fld.subfolders
'把文件夹名称赋予B列
Cells(i + 1, 2) = fd.Name
'关键是fd.size/1024的运算
Cells(i + 1, 3) = FormatNumber(fd.Size / 1024, 0) & "KB"
'使用累加器
i = i + 1
Next
End Sub
'知识点十:复制文件夹
Sub Copyfile()
'定义变量fso,fs
Dim fso, fs
'调用Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
'取得需要复制的文件夹对象
Set fs = fso.getfolder(ThisWorkbook.Path & "\SQL高级")
'使用copy方法复制到SQL初级文件夹中
fs.Copy (ThisWorkbook.Path & "\SQL初级\")
'显示成功复制
MsgBox "OK!"
End Sub
