精华内容
下载资源
问答
  • VBA 搜索文件的工具

    2014-11-13 10:21:56
    刚开始学习VBA做的一个小工具,用来搜索文件的内容。
  • 将需要查找所有文件的文件夹地址赋给数组,成为arr(1) 2.使用folder.subfolders属性将子文件夹继续赋给数组,成为arr(i) 3.使用folder.files属性访问所有文件夹内的文件 核心算法就是,将子文件夹地址不断加入...

    整体思路是:
    1.将需要查找所有文件的文件夹地址赋给数组,成为arr(1)
    2.使用folder.subfolders属性将子文件夹继续赋给数组,成为arr(i)
    3.使用folder.files属性访问所有文件夹内的文件
    核心算法就是,将子文件夹地址不断加入数组,然后遍历数组中的每一个地址访问文件

    首先需要添加引用:Microsoft Scripting runtime
    在这里插入图片描述
    添加用在这里插入图片描述

    Sub 所有文件夹()
    Dim fs As New FileSystemObject, arr(), i, j, k
    Dim fd, subfd As Folder
    Dim files As file
    Set fp = Application.FileDialog(msoFileDialogFolderPicker) '选择需要查询文件的文件夹
    fp.Show
    Set paths = fp.SelectedItems
    ReDim arr(1)
    arr(0) = paths(1) '文件夹路径赋给数组
    Application.ScreenUpdating = False
    Do Until i > k
        Set fd = fs.GetFolder(arr(i))
        For Each files In fd.files
            j = j + 1
            Range("a" & j + 1).Hyperlinks.Add Anchor:=Range("a" & j + 1), Address:=files.path, TextToDisplay:=files.Name
            Range("b" & j + 1) = files.DateLastModified
            Range("C" & j + 1) = files.Size \ 1024 & "KB"
        Next
        For Each subfd In fd.SubFolders
            k = k + 1
            ReDim Preserve arr(k + 1)
            arr(k) = subfd  ’将子文件夹赋给数组
        Next
        i = i + 1
    Loop
    MsgBox ("一共有" & j & "个文件," & k & "个文件夹")
    Application.ScreenUpdating = True
    End Sub
    
    
    
    
    
    展开全文
  • 获取当前文件夹的名称(CurDir 函数)当你使用文件时,经常会需要知道当前文件夹的名称,你使用CurDir函数轻易地获取该信息:CurDir([drive])Drive是一可选参数,如果你忽略它,VBA将使用当前驱动(drive)。CurDir函数...

    获取当前文件夹的名称(CurDir 函数)

    当你使用文件时,经常会需要知道当前文件夹的名称,你使用CurDir函数轻易地获取该信息:

    CurDir([drive])

    Drive是一可选参数,如果你忽略它,VBA将使用当前驱动(drive)。

    CurDir函数返回一个文件路径作为Variant(变量)。如果要返回作为字符串(String)的路径的话,就得使用CurDir$(这里的$是字符串的类型声明字符)。让我们在立即窗口里做些练习,练习使用这些函数吧:
    1. 打开一个新工作簿,并且切换到VB编辑器窗口

    2. 激活立即窗口并敲入下述代码:

    ?CurDir

    当你按下回车,VB就显示当前文件夹名称,例如:
    C:
    如果你有第二个硬盘(或者光驱)的话,你可以获取D盘上的当前文件夹,例如:

    ?CurDir(“D:”)

    如果你提供了一个并不存在的驱动字母的话,VB就将显示下述错误信息:“设备不可用”

    3. 要储存当前动名称到变量myDrive,可以输入下述指令:

    myDrive = Left(CurDir$,1)

    当你按下回车键时,VB将当前驱动器的字母储存到变量myDrive
    敲入下述指令并回车,可以检查变量myDrive的内容:

    ?myDrive

    你还可以将上面的指令改为如下:

    myDrive = left(CurDir$,1) & ":"

    VB将返回驱动器字母,后面带有一个冒号。

    更改文件或文件夹名称(Name 函数)

    使用函数Name可以重命名文件或者文件夹,例如:

    Name old_pathname As new_pathname

    Old_pathname是你想用重命名的文件或文件夹的名称和路径,New_pathname则明确文件或文件夹的新名称和位置。使用函数Name,你可以将一个文件从一个文件夹移动到另外一个文件夹,但是,你不可以移动文件夹。
    请在立即窗口里试演该函数(用你文件的实际名称替换示例名称)。这里有些需要考虑的注意事项:
    ①在New_pathname里的文件名称不要指向已经存在的文件
    Name "C:System.1st " As "C:est.txt"
    因为文件C:est.txt已经存在于C盘,VB将显示错误信息:“文件已存在”,同样,如果你要重命名的文件不存在的话,就会出现“文件未找到”的错误信息。

    ②如果New_pathname已经存在,并且和Old_pathname不同,函数Name必要时将文件移动到新文件夹并且更改它的名称。
    Name "C:System.1st " As "D:est.txt"
    因为文件test.txt在D盘的根目录下并不存在,VB将C:System.1st
    移动到指定的驱动盘,然而,并不重命名该文件。(本段与上面的内容似乎矛盾,而且未能试验成功,未知是原书失误与否。读者应仔细验证)

    ③如果New_pathname和Old_pathname指向不同的目录,以及提供的文件名称相同,那么Name函数将指定的文件移到新地址,不用更改文件名。
    Name "D:est.txt " As "C:DOSest.txt"
    上面的指令将test.txt移动到C盘下的DOS文件夹里。

    技巧:你不能重命名开启的文件
    在重命名文件之前,你必须关闭该文件。文件名称里不能包含通配符“*”或者“?”。

    检查文件或文件夹是否存在(Dir 函数)

    Dir函数,返回文件或者文件夹名称,语法如下:

    Dir[(pathname[, attributes])]

    Dir函数的两个参数都是可选的,pathname是文件或文件夹名称,对于参数attributes,你可以下列常量或者数值之一:

    0afb6c2c71d6807ad77fec9f08ad1c77.png

    Dir函数常用来检查某个文件或文件夹是否存在,如果不存在,那么就返回空字符串(””)。我们到立即窗口里试验几个Dir函数的练习:

    1. 在立即窗口,输入下述指令:

    ?Dir("C:", vbNormal)

    你一旦按下回车键,VB就会返回该文件夹下的第一个文件名。普通文件(vbNormal)就是除隐藏,卷标,目录,文件夹或系统文件之外的任何文件。
    要返回当前目录下的其它文件名称的话,就使用不带参数的Dir函数:
    ?Dir (并且回车)
    2. 在立即窗口里输入下列指令,并且在你回车时检查其结果:

    mfile = Dir("C:", vbHidden)?mfilemfile = Dir?mfilemfile = Dir?mfile


    3. 在立即窗口输入下述指令:

    If Dir("C:stamp.bat") = "" Then Debug.Print "文件未找到。"

    因为stamp.bat文件不在C盘上,所以VB就在立即窗口里写下文本信息“文件未找到。”

    4. 在立即窗口输入下述语句,可以检查某文件是否存在于某驱动盘上:

    If Dir ("C:Autoexec.bat") <>"" Then Debug.Print "该文件不在C盘上。"

    函数Dir允许你在文件路径名中使用通配符——星号(*)代表多个字符,问号(?)代表单个字符:

    例如,要在WINDOWS文件夹中查找所有配置设置的文件,你可以查找所有的INI文件,如下:

    ?Dir("C:WINNT*.ini", vbNormal)system.ini?dir WIN.INI?dirWINFILE.INI?dir control.ini?dir EQUIP32.INI?dirsxpwin32.ini

    下面显示的过程在立即窗口里写上了确定目录下的文件名称。函数LCase$让文件名称显示为小写字母。

    1. 打开一新工作簿,并保存为Chap08.xls

    2. 切换到VB编辑器窗口并重命名VBA工程为FileMan
    3. 插入新模块,重命名为DirFunction
    4. 输入下述VBA过程:

    Sub MyFiles()Dim mfile As StringDim mpath As Stringmpath = InputBox("Enter pathname,e.g., C:Excel")If Right(mpath, 1) <> "" Then mpath = mpath & ""mfile = Dir(mpath & "*.*")If mfile <> "" Then Debug.Print "Files in the " & mpath _& "folder"Debug.Print LCase$(mfile)If mfile = "" ThenMsgBox "No files found."Exit SubEnd IfDo While mfile <> ""mfile = DirDebug.Print LCase$(mfile)LoopEnd Sub

    上面的过程myFiles向用户询问文件路径名。如果该路径结尾没有反斜杠,函数Right就会将反斜杠附加在路径名字符串上。接下来,VB在该确定的文件夹里搜索所有文件(*)。如果没有文件的话,就会有信息显示,如果文件存在,那么文件名就会被写入立即窗口。

    5. 在同一个模块里输入另外一个过程:

    Sub GetFiles()Dim nfile As StringDim nextRow As IntegernextRow = 1'next row indexWith Worksheets("Sheet1").Range("A1")nfile = Dir("C:", vbNormal).Value = nfileDo While nfile <> ""nfile = Dir.Offset(nextRow, 0).Value = nfilenextRow = nextRow + 1LoopEnd WithEnd Sub

    过程GetFiles获取C盘根目录下的所有文件名并且将每个文件名写入工作表。
    4.获得文件修改的日期和时间(FileDateTime 函数)

    如果你的过程需要知道某文件的最后修改的时间的话,可以使用函数FileDateTime:
    FileDateTime(文件路径名)
    文件路径名是个字符串,明确你要用的文件,并且需要包括驱动和文件夹的名称。该函数返回某文件的日期和时间印记。日期和时间的格式取决于视窗控制面板的原始设置。
    我们在立即窗口里来练习使用该函数:

    1. 在立即窗口里输入:

    ?FileDateTime("C:config.sys")

    回车后,VB返回下述格式的日期和时间 5/4/2001 10:52:00 AM
    要分开获取日期和时间时,可以将函数FileDateTime作为函数DateValue或TimeValue的参数来使用。例如:

    ?DateValue(FileDateTime("C:config.sys"))?TimeValue(FileDateTime("C:config.sys"))

    2. 在立即窗口里将下述语句在一行输入:

    If DateValue(FileDateTime("C:config.sys"))< Date then Debug.Print "This file was notmodified today.”

    Date函数返回当前系统日期,也是视窗控制面板的日期

    对话框里设定的。

    获得文件大小(FileLen 函数)

    如果你需要检查某文件是否能够存在某磁盘上,那么你应该按照下述方式使用FileLen函数:
    FileLen(文件路径名)

    FileLen函数一字节方式返回文件的大小。如果该文件已打开,那么VB将返回该文件最后一个保存时的大小。

    假设你想要获取Windows目录下进行配置设置的所有文件的总大小:

    1. 在当前工程里插入新模块,并重命名为FileLenFunction
    2. 在代码窗口了输入过程TotalBytesIni:

    Sub TotalBytesIni()Dim iniFile As StringDim allBytes As LonginiFile = Dir("C:WINDOWS*.ini")allBytes = 0Do While iniFile <> ""allBytes = allBytes + FileLen("C:WINDOWS" & iniFile)iniFile = DirLoopDebug.Print "Total bytes: " & allBytesEnd Sub
    展开全文
  • 这是一个仿api调用方式的文件查找代码,在office 2010验证通过。 调用时,查到的文件直接在调用函数的参数中返回,调用时给出参数名称,函数自动返回数组结果。可以返回文件名,文件大小,创建日期,修改日期。 是在...
  • 查找文件夹下文件,自动生成目录,即时打开链接
  • VBA自带的dir()判断,代码如下: 在 Microsoft Windows 中, Dir 支持多字符 (*)和单字符 (?) 的通配符来指定多重文件 Function IsFileExists(ByVal strFileName As String) As Boolean If Dir(strFileName, 16)...

    方法1. 用VBA自带的dir()判断,代码如下:

    在 Microsoft Windows 中, Dir 支持多字符 (*)和单字符 (?) 的通配符来指定多重文件

    Function IsFileExists(ByVal strFileName As String) As Boolean
        If Dir(strFileName, 16) <> Empty Then
            IsFileExists = True
        Else
            IsFileExists = False
        End If
    End Function
     
    Sub Run()
        If IsFileExists("D:\vba\abc.txt") = True Then
        ' 文件存在时的处理
            MsgBox "文件存在!"
        Else
        ' 文件不存在时的处理
            MsgBox "文件不存在!"
        End If
    End Sub

    方法2. 用Windows的文件系统函数进行判断,代码如下:

    Function IsFileExists(ByVal strFileName As String) As Boolean
        Dim objFileSystem As Object
     
        Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        If objFileSystem.fileExists(strFileName) = True Then
            IsFileExists = True
        Else
            IsFileExists = False
        End If
    End Function
     
    Sub Run()
        If IsFileExists("D:\vba\abc.txt") = True Then
        ' 文件存在时的处理
            MsgBox "文件存在!"
        Else
        ' 文件不存在时的处理
            MsgBox "文件不存在!"
        End If
    End Sub
    展开全文
  • Dim DicFolders As Variant Private Sub ExportFormat(format As String) Dim ArrFileName() As String, ArrLan() As String, i&amp; Dim sheetName As String, sheetActive As Variant, m&...
    Dim DicFolders As Variant
    Private Sub ExportFormat(format As String)
        Dim ArrFileName() As String, ArrLan() As String, i&
        Dim sheetName As String, sheetActive As Variant, m&, lIndex As Long, inteval&
        On Error Resume Next
        sheetName = format + "Language.xls"
        Workbooks.Add
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" + sheetName, True
        ArrFileName = ExtractFileName(ThisWorkbook.Path, ".pas")
        Windows(sheetName).Activate
        Set sheetActive = ActiveSheet
        sheetActive.Cells(1, 1) = "FileName"
        sheetActive.Cells(1, 2) = "FilePath"
        sheetActive.Cells(1, 3) = "Information"
        lIndex = 2
        inteval = 2
        For i = LBound(ArrFileName) To UBound(ArrFileName)
            If (ArrFileName(i) <> "") Then
                strText = ReadText(ArrFileName(i), format)
                ArrLan = FindString(strText, "frmLan.GetLanStr\((.*\s.*\s.*\s.*)\)")
             ' save result to excel
             For m = LBound(ArrLan) To UBound(ArrLan)
                If m = 0 Then
                    sheetActive.Cells(lIndex, 1) = Right(ArrFileName(i), Len(ArrFileName(i)) - InStrRev(ArrFileName(i), "\"))
                    sheetActive.Cells(lIndex, 2) = ArrFileName(i)
                End If
                sheetActive.Cells(m + lIndex, 3) = ArrLan(m)
             Next m
             lIndex = lIndex + m + inteval
            End If
        Next i
    End Sub
    Private Sub btnExport_Click()
       ExportFormat ("UTF-8")
    End Sub
    Sub btnExportGB_Click()
       ExportFormat ("GB2312")
    End Sub
    'FilePath:Current File Path
    'FileFilter:suffix such as .pas,.txt
    ' return : array of string
    Function ExtractFileName(ByVal FilePath As String, Optional ByVal FileFilter As String = "*.*") As String()
    Dim i&, n&, Mypath$, Arr() As String, strIndex As String
    On Error Resume Next
        Set DicFolders = CreateObject("Scripting.Dictionary")
        DicFolders.Add (FilePath & "\"), ""
        i = 0
        Do While i < DicFolders.Count
            ke = DicFolders.keys
            Filename = Dir(ke(i), vbDirectory)
                Do While Filename <> ""
                    If Filename <> "." And Filename <> ".." Then
                        If (GetAttr(ke(i) & Filename) And vbDirectory) = vbDirectory Then
                            DicFolders.Add (ke(i) & Filename & "\"), ""
                        End If
                    End If
                    Filename = Dir
                Loop
            i = i + 1
        Loop
      i = 0
    '**********************************************************************************
            For Each ke In DicFolders.keys
                MyFliename = Dir(ke)
                Do While MyFliename <> ""
                   strIndex = Right(MyFliename, 4)
                   If strIndex = FileFilter Then
                        ReDim Preserve Arr(i)
                        Arr(i) = ke & MyFliename
                        i = i + 1
                   End If
                    MyFliename = Dir
                Loop
            Next
        ExtractFileName = Arr
    
    End Function
    ' Description:read the txt file and return as as string
    ' FilePath:the absolute path of the file
    ' strFormat:the text format such as UTF-8,GB2312
    ' Return an String
    Function ReadText(FilePath As String, strFormat As String) As String
        'Dim fso As Variant, f As Variant
        'Set fso = CreateObject("Scripting.FileSystemObject")
        'Set f = fso.OpenTextFile(FilePath)
        'ReadText = f.ReadAll
        Dim st As Variant
        Set st = CreateObject("ADODB.Stream")
        st.Type = 2
        st.Mode = 3
        st.Open
        st.LoadFromFile FilePath
        st.Charset = strFormat
        ReadText = st.ReadText
        st.Close
    End Function
    'Description:Find the strings that match with the Regular Format
    'strText:string to be find
    'RegFormat:Regular expressions
    'return as an array of string
    Function FindString(strText As String, Optional ByVal RegFormat As String = "*.*") As String()
        Dim Reg As Variant, m As Variant, Arr() As String, n&
        Set Reg = CreateObject("vbScript.RegExp")
        If strText <> "" Then
            Reg.Pattern = RegFormat
            Reg.Global = True
            Reg.IgnoreCase = True
            Reg.MultiLine = False
            ReDim Preserve Arr(1)
            For Each m In Reg.Execute(strText)
                n = n + 1
                ReDim Preserve Arr(n)
                Arr(n) = m
            Next
        End If
        FindString = Arr
    End Function

     

    展开全文
  • VBA个人 最初的想法是为personal.xlsb一个存储库。...在我看来,构建一个样板文件(作为每个VBA项目的起点)将是很长的。 在2016年的某个地方,我决定将我正在使用的所有有用的VBA代码放在一个存储库中。 该存储库当前
  • VBA是Office软件所支持的,可以自动处理重复,复杂的流程的脚本。该脚本涉及使用VBA打开另一个excel,并获取数据;使用模糊查询算法获取数据;流程控制语句If、While、Set、With等语句。对于学习和相关用途十分有帮助...
  • 可以判断各种情况 like = 多个条件 包含中文等等 Sub test_jackma1() path1 = ThisWorkbook.Path Dim fso As Object Dim fd1 As Object Dim f1 As Object Set fso = CreateObject("scripting....Debug....
  • 1 DIR基本功能 1.1Dir函数 ... 返回一个String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的模式或文件属性、或磁盘卷标相匹配。 pathname 可选参数。用来指定文件名的字符串表达式,...
  • Sub 遍历文件夹下所有文件() ' ' ' Dim MyFile As String Dim Arr(100) As String Dim count As Integer MyFile = Dir("C:\Users\60930\Desktop\孔隙体积压缩系数-已完成67\孔隙体积数据2020.12.20-51块\" &...
  • EXCEL-VBA复制文件夹

    2018-01-11 17:04:13
    VBA编写的复制文件夹工具
  • vba判断文件是否存在的两种方法

    万次阅读 2013-10-12 12:56:18
    VBA自带的dir()判断,代码如下: 在 Microsoft Windows 中, Dir 支持多字符 (*) 和单字符 (?) 的通配符来指定多重文件 Visual Basic   Function IsFileExists(ByVal strFileName As String)...
  • VBA】判断文件或文件夹是否存在

    千次阅读 2018-12-11 22:34:19
    一、判断文件或文件夹是否存在 Function FileFolderExists(strFullPath As String) As Boolean On Error GoTo EarlyExit If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True ...
  • Excel VBA实现 通过文件名查找全路径

    千次阅读 2013-07-08 23:14:52
    VBA 提供一组文件名,得到所有文件的相对于工程的目录(版本1.5) 调用bat实现 #mode con cols=15 lines=1 set fileName=%1% set projectPath=%2% cd %projectPath% dir/a/s %filename% Private Sub ...
  • Excel-VBA操作文件四大方法

    万次阅读 2017-12-21 15:26:48
    Excel-VBA操作文件四大方法之一 在我们日常使用Excel的时候,不仅会用到当前Excel文件的数据,还经常需要访问其他的数据文件。这些数据文件可能是Excel文件、文本文 件或数据库文件等。经常有朋友会问如何在vba...
  • VBA 有很多用于文件操作的语句和函数,能满足绝大多数场景下的文件操作要求。本文将按操作目的一一进行介绍。
  • 文件夹里面保存有面单扫描的图像文件文件名为邮件号码,现在想收集这些邮件号码,因为量很大,不可能一个一个的截取,只能通过程序实现,假定,当前工作表B列里放的是存放这些图像文件的文件夹,下面的程序可以讲...
  • vba 电子表格 宏代码 编程 用VBA代码实现遍历某文件夹下所有*.xls*文件,有两种实现方法
  • VBA之跨文件复制拷贝

    千次阅读 2019-06-23 09:34:01
    我们在使用VBA的时候,如果想对文件里面的内容进行跨文件拷贝,我需要使用到一种方法,首先对我们需要拷贝的文件,进行路径写死进行访问,如下代码示例: a = "xxx.xlsm" Workbooks(a).Activate Workbooks(a)...
  • 'VBA打开文件选择框、取得文件全路径与文件名 Sub selectExcelfile() Dim fileNameObj As Variant Dim aFile As Variant '数组,提取文件名fileName时使用 '打开文件对话框返回的文件名,是一个全路径文件名,...
  • 两句代码快速提高VBA运行效率 正则表达式,查找、筛选数据的利器,你不能不会! 4、Python实例(附源码) 1、教你如何用python制作一个微信机器人陪你聊天,只要几行代码 2、用python定制网页跟踪神器,有信息更新第...
  • 目录里面保存有面单扫描的图像文件文件名称为邮件号码。如今想收集这些邮件号码,由于量非常大,不可能一个一个的截取,仅仅能通过程序实现。假定,当前工作表B列里放的是存放这些图像文件的目录。以下的程序能够...
  • Excel-VBA文件操作

    千次阅读 2018-10-05 02:16:29
    2、利用VBA文件处理语句来处理文件; 3、利用FileSystemObject对象来处理文件; 4、利用API函数来处理文件。 对于数据库文件,还可以利用ADO+SQL的方法操作,本文不讨论 利用Excel对象自带的方法来操作文件是最...
  • vba dir 判断文件是否存在

    千次阅读 2019-02-06 17:01:23
    我们主要使用VBA中的Dir方法来判断文件是否存在。 Dir函数返回的是文件名、目录名或文件夹名称。 这里还使用了Len方法判断Dir是否返回了结果。 如果Dir返回的值长度为0,则Dir没有返回文件名。 Sub Run() Dim ...
  • 开始参考了 VBA获取某文件夹下所有文件和子文件目录的文件中的代码,按照此方式获取的结果有问题。 问题1 无法获取目录名中包含“.”的子目录 '-- 获得所有子目录 Do Until i > k f = Dir(file(i), vbDirectory)...
  • 查找文件vba

    2010-07-26 09:25:00
    Sub test() Dim MyFile, MyPath, MySz MyPath = "D:/Data/z/" ' 指定路径。' 显示 路径目录下的名称。... MySz = Dir ' 查找下一个目录。 Loop End Sub   谢谢啦~~~~~~~~~~~~~~~~~~~~
  • vba遍历文件夹中的文件夹 使用方便 (Ease of use) The goal is to read and create cabinet folders with no third-party tools or libraries that are not already present in the user's machine. As you will see...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 5,971
精华内容 2,388
关键字:

vba查找文件