美文网首页
VBA 操作文件相关的技巧总结

VBA 操作文件相关的技巧总结

作者: 崔渣渣 | 来源:发表于2017-04-17 15:00 被阅读0次

    '适用于知识点六的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

    相关文章

      网友评论

          本文标题:VBA 操作文件相关的技巧总结

          本文链接:https://www.haomeiwen.com/subject/jdutzttx.html