精华内容
下载资源
问答
  • 用于获取所有指定目录下所有文件名,用vba写的小access程序
  • Sub tiqu() '提取文件夹下所有文件名[张志晨] '路径由浏览文件夹根据需要指定。这样灵活! Dim strFileName As String'文件名
  • 通过excel文件,点击按钮通过资源管理器自动获取目标文件夹内的文件名,并进行修改
  • Excel vba获取文件夹文件名

    千次阅读 2019-10-05 00:50:21
    '获取文件夹中的所有文件列表 varFileList = fcnGetFileList(strFolder) If Not IsArray(varFileList) Then MsgBox "未找到文件", vbInformation Exit Sub End If For x = 0 To UBound(varFileList) Cells(x + 1,...

    来源:http://www.360doc.com/content/13/1225/16/1086327_340041443.shtml

     

    Sub test()
    Dim strFolder As String
    Dim varFileList As Variant
    Dim FSO As Object, myFile As Object
    Dim myResults As Variant
    Dim l As Long

    '显示打开文件夹对话框
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub '未选择文件夹
    strFolder = .SelectedItems(1)
    End With
    '获取文件夹中的所有文件列表
    varFileList = fcnGetFileList(strFolder)
    If Not IsArray(varFileList) Then
    MsgBox "未找到文件", vbInformation
    Exit Sub
    End If

    For x = 0 To UBound(varFileList)
    Cells(x + 1, 1) = varFileList(x)
    Next x

    End Sub

    Private Function fcnGetFileList(ByVal strPath As String, Optional strFilter As
    String) As Variant


    ' 将文件列表放到数组
    Dim f As String
    Dim i As Integer
    Dim FileList() As String


    If strFilter = "" Then strFilter = "*.*"
    Select Case Right(strPath, 1)
    Case "\", "/"
    strPath = Left(strPath, Len(strPath) - 1)
    End Select

    ReDim Preserve FileList(0)
    f = Dir(strPath & "\" & strFilter)
    Do While Len(f) > 0
    ReDim Preserve FileList(i) As String
    FileList(i) = f
    i = i + 1
    f = Dir()
    Loop
    If FileList(0) <> Empty Then
    fcnGetFileList = FileList
    Else
    fcnGetFileList = False
    End If
    End Function

    转载于:https://www.cnblogs.com/panli-32/p/9169408.html

    展开全文
  • 开始参考了 VBA获取文件夹下所有文件和子文件目录的文件中的代码,按照此方式获取的结果有问题。 问题1 无法获取目录名中包含“.”的子目录 '-- 获得所有子目录 Do Until i > k f = Dir(file(i), vbDirectory)...

    公司运营部门需要把影像资料梳理一遍,文件目录特别多,文件量也大,大概40多个G。自己写了一个读取目录下所有子文件的脚本
    开始参考了 VBA获取某文件夹下所有文件和子文件目录的文件中的代码,按照此方式获取的结果有问题。
    问题1 无法获取目录名中包含“.”的子目录

    '-- 获得所有子目录
    Do Until i > k
        f = Dir(file(i), vbDirectory)
            Do Until f = ""
                If InStr(f, ".") = 0 Then
                    k = k + 1
                    ReDim Preserve file(1 To k)
                    file(k) = file(i) & f & "\"
                End If
                f = Dir
            Loop
        i = i + 1
    Loop
    

    代码中使用InStr(f, “.”) = 0 判断,只要名字中包含"."就按照文件处理

    问题2 无法获取扩展名为空的文件

    '-- 获得所有子目录下的所有文件
    For i = 1 To k
       f = Dir(file(i) & "*.*")    '通配符*.*表示所有文件,*.xlsx Excel文件
       Do Until f = ""
          'Range("a" & x) = f
          Range("a" & x).Hyperlinks.Add Anchor:=Range("a" & x), Address:=file(i) & f, TextToDisplay:=f
           x = x + 1
           f = Dir
       Loop
    Next
    

    于是,自己实现了一个支持文件夹名称带“.”或文件名不带扩展名的。
    实现过程
    新建一个文件,在sheet1中增加两个按钮,一个用来选取文件夹,一个用来执行查询

    1. 选择文件脚本
    Option Explicit
    Sub 打开文件夹()
    
       With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = -1 Then
                Worksheets("Sheet1").Range("C5").Value = .SelectedItems(1)
            End If
        End With
     
    End Sub
    
    
    1. 执行脚本
    
    Sub 按钮1_Click()
    
    On Error Resume Next
    
    Dim folderObj As Object
    Dim currFolder
    Dim fdCnt As Integer
    
    Dim sDir As String
    
    Dim dirExist, f As String
    Dim file(), subFolder(), allfd() As String
    Dim fileNum, k, x, idx, i, j, listNum
    Dim threeDir As String
    
    fileNum = 1
    x = 1
    k = 1
    j = 0
    i = 1
    
    sDir = Worksheets("Sheet1").Range("C5").Value
    
    '=== 0.清除数据=============================================
    Sheet2.UsedRange.Clear
    
    Worksheets("Sheet2").Range("A1").Value = "序号"
    Worksheets("Sheet2").Range("C1").Value = "文件名"
    Worksheets("Sheet2").Range("D1").Value = "文件路径"
    Worksheets("Sheet2").Range("E1").Value = "文件格式"
    Worksheets("Sheet2").Range("E1").Interior.Color = RGB(255, 255, 0)
    Worksheets("Sheet2").Range("A1").Interior.Color = RGB(255, 255, 0)
    Worksheets("Sheet2").Range("C1").Interior.Color = RGB(255, 255, 0)
    Worksheets("Sheet2").Range("D1").Interior.Color = RGB(255, 255, 0)
    Worksheets("Sheet2").Range("E1").Borders.LineStyle = xlContinuous
    Worksheets("Sheet2").Range("A1").Borders.LineStyle = xlContinuous
    Worksheets("Sheet2").Range("C1").Borders.LineStyle = xlContinuous
    Worksheets("Sheet2").Range("D1").Borders.LineStyle = xlContinuous
    
    '=== 1.判断选择的文件夹是否有效===============================
    
    dirExist = dir(sDir, vbDirectory)
    If dirExist = "" Then
        MsgBox ("选择的文件夹无效")
        Exit Sub
    End If
    
    '=== 2.获取所有子目录======================================
    
    ReDim subFolder(1 To i)
    
    subFolder(1) = sDir & "\"
    f = dir(subFolder(1), vbDirectory)
    Do Until f = ""
        If f <> "." And f <> ".." Then
            If (GetAttr(subFolder(1) & f) And vbDirectory) = 16 Then
                'Worksheets("Sheet3").Range("A" & k).Value = subFolder(1) & f & "\"
                k = k + 1
                ReDim Preserve subFolder(1 To k)
                subFolder(k) = subFolder(1) & f & "\"
            End If
        End If
        f = dir
    Loop
    i = i + 1
    
    Dim tmp As Integer
    tmp = 0
    
    For Each fd In subFolder
        tmp = tmp + 1
        ReDim Preserve allfd(1 To tmp)
        i = 1
        k = 1
        Erase file
        ReDim file(1 To i)
        file(i) = fd
        allfd(tmp) = fd
        Worksheets("Sheet3").Range("B" & tmp).Value = allfd(tmp)
    
        If subFolder(1) = file(i) Then
             f = dir
            i = i + 1
        Else
    
        Do Until i > k
            f = dir(file(i), vbDirectory)
            Do Until f = ""
                If f <> "." And f <> ".." Then
                    If (GetAttr(file(i) & f) And vbDirectory) = 16 Then
                        k = k + 1
                        ReDim Preserve file(1 To k)
                        file(k) = file(i) & f & "\"
                        tmp = tmp + 1
                        ReDim Preserve allfd(1 To tmp)
                        allfd(tmp) = file(i) & f & "\"
                       ' Worksheets("Sheet3").Range("B" & tmp).Value = allfd(tmp)
                    End If
                End If
                f = dir
            Loop
            i = i + 1
        Loop
        End If
    Next
    
    '=== 3.获取所有子目录下的文件======================================
    '
    Dim threeStr As String
    
    x = 2
    idx = 1
    For i = 1 To tmp
      
        f = dir(allfd(i) & "*.*")
        Do Until f = ""
            Worksheets("Sheet2").Range("A" & x).Value = idx
            Worksheets("Sheet2").Range("C" & x).Value = f
            Worksheets("Sheet2").Range("D" & x).Value = Replace(allfd(i), sDir, "") & f
            'Worksheets("Sheet2").Range("E" & x).Value = getFileType(f)
            
            'Worksheets("Sheet2").Range("B" & x).NumberFormatLocal = "@"
            'Worksheets("Sheet2").Range("B" & x).Value = getToubaodanHao(sDir, allfd(i))
    
          
            f = dir
            x = x + 1
            idx = idx + 1
        Loop
      
    Next
    
    
    End Sub
    
    
    
    

    最终效果:
    在这里插入图片描述
    在这里插入图片描述

    参考

    1. W3CSchool VBA教程
    2. VBA获取某文件夹下所有文件和子文件目录的文件
    3. VBA 快速入门
    展开全文
  • 一、提取单层文件内的文件名 ... '获取用户选择文件夹的路径 With Application.FileDialog(msoFileDialogFolderPicker) '选择文件夹 If .Show Then p = .SelectedItems(1) '选择的文件路径赋值变量P Else

    一、提取单层文件内的文件名

    只会提取到文件,如果是文件夹自动忽略。

    Sub FileDir()
        Dim p$, f$, k&
        '获取用户选择文件夹的路径
        With Application.FileDialog(msoFileDialogFolderPicker)
       '选择文件夹
            If .Show Then
                p = .SelectedItems(1)
                '选择的文件路径赋值变量P
            Else
                Exit Sub
                '如果没有选择保存路径,则退出程序
            End If
        End With
        If Right(p, 1) <> "\" Then p = p & "\"
        f = Dir(p & "*.*")
        '返回变量P指定路径下带任意扩展名的文件名
        '如果有超过一个文件存在,将返回第一个找到的文件名
        '如果一个文件都没有,则返回空
        [a:a].ClearContents '清空A列数据
        [a1] = "目录"
        k = 1
        Do While f <> ""
        '如果文件名不为空,则……
            k = k + 1
            '累加文件个数
            Cells(k, 1) = f
            f = Dir
            '第二次调用Dir函数,但不带任何参数,则将返回同一目录下的下一个文件。
        Loop
        MsgBox "OK"
    End Sub
    

    二、提取多层文件夹内的文件名

    分别将文件夹名称和文件名提取在表格的A/B列,并对文件名创建了超链接

    Sub AutoAddLink()
        Dim strFldPath As String
        With Application.FileDialog(msoFileDialogFolderPicker)
        '用户选择指定文件夹
            .Title = "请选择指定文件夹。"
            If .Show Then strFldPath = .SelectedItems(1) Else Exit Sub
            '未选择文件夹则退出程序,否则将地址赋予变量strFldPath
        End With
        Application.ScreenUpdating = False
        '关闭屏幕刷新
        Range("a:b").ClearContents
        Range("a1:b1") = Array("文件夹", "文件名")
        Call SearchFileToHyperlinks(strFldPath)
        '调取自定义函数SearchFileToHyperlinks
        Range("a:b").EntireColumn.AutoFit
        '自动列宽
        Application.ScreenUpdating = True
        '重开屏幕刷新
    End Sub
    Function SearchFileToHyperlinks(ByVal strFldPath As String) As String
        Dim objFld As Object
        Dim objFile As Object
        Dim objSubFld As Object
        Dim strFilePath As String
        Dim lngLastRow As Long
        Dim intNum As Integer
        Set objFld = CreateObject("Scripting.FileSystemObject").GetFolder(strFldPath)
        '创建FileSystemObject对象引用
        For Each objFile In objFld.Files
        '遍历文件夹内的文件
            lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            strFilePath = objFile.Path
            intNum = InStrRev(strFilePath, "\")
            '使用instrrev函数获取最后文件夹名截至的位置
            Cells(lngLastRow, 1) = Left(strFilePath, intNum - 1)
            '文件夹地址
            Cells(lngLastRow, 2) = Mid(strFilePath, intNum + 1)
            '文件名
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(lngLastRow, 2), _
                        Address:=strFilePath, ScreenTip:=strFilePath
            '添加超链接
        Next objFile
        For Each objSubFld In objFld.SubFolders
        '遍历文件夹内的子文件夹
            Call SearchFileToHyperlinks(objSubFld.Path)
        Next objSubFld
        Set objFld = Nothing
        Set objFile = Nothing
        Set objSubFld = Nothing
    End Function
    

     

     

    展开全文
  • //获取当前文件夹及其子文件夹所有文件名,保存到数组中。 //作者 :刘辉 时间 2017年9月18日00:46:06 function listFiles($dir) {  //打开目录  //static这个关键字非常重要。因为这是递归调用,否则会...
    <?php   
    
    //获取当前文件夹及其子文件夹的所有文件名,保存到数组中。
    //作者 :刘辉   时间  2017年9月18日00:46:06
    function listFiles($dir)  
    {  
        //打开目录  
        //static这个关键字非常重要。因为这是递归调用,否则会把之前的值给覆盖掉。
        static $tempArr=[];
        $handle=opendir($dir); 


        //阅读目录  
        while(false!==($file=readdir($handle)))  
        {  
             //列出所有文件并去掉'.'和'..'  
             if($file!='.'&&$file!='..')  
             {  
                //所得到的文件名是否是一个目录  
                 if(is_dir("$dir/$file"))  
                 {  
                    //列出目录下的文件  
                     listFiles("$dir/$file");  
                 }  
                 else  
                 {  
                        //如果是文件则打开该文件  
      
                       
                       
                      $tempArr[]=$dir."/".$file."<br/>" ;                  
                                            
                }  
            }  
             }  
            return $tempArr;
            

     /*------------------------------------------*/  
        //调用  
        $dir=getcwd();  
        print_r(listFiles($dir));  
    展开全文
  • (2)打开后按住Alt再按F11,这样就会打开vba代码编辑器 (3)点菜单栏上的“插入”,选择“模块”,这样在左下角就会出现一个“模块1” (4)双击“模块1”,右边就会出现“模块1”的编辑界面,将以下代码复制,...
  • Sub 提取指定文件夹内的所有文件名() '含所有文件夹内的文件 Dim Fso As Object, arrf$(), mf& Set Fso = CreateObject("Scripting.FileSystemObject") Call GetFiles(CreateObject("Shell.Application")....
  • &lt;strong&gt;VBA获取文件夹下所有文件,或子文件目录的文件&lt;/strong&gt; '-----------------------------------
  • VBA读取文件夹下所有文件的三种方法,能够读取到子文件夹下所有的文件。
  • " & fso.GetBaseName(fn) ActiveSheet.Hyperlinks.Add anchor:=Selection, Address:=folder_location & fn Next End Sub 运行结果 选中某一单元格,输出结果会在此单元格后方出现 运行代码 自动读取文件夹文件名并...
  • 既然FSO对象是操作文件(夹)神器,那么今天我们就用VBA编程来实现将指定文件夹内的所有文件名提取到Excel并生成超链接。具体实现效果如下:这个例程中,我们用到了FSO对象的GetFolder方法。具体实现代码如图所示:S...
  • Excel VBA批量修改文件夹下文件名

    千次阅读 2013-07-31 16:22:25
    今天,有同事提出想批量修改文件名,规则比较简单,在第五位后加“-”即可, 上网没找到相关工具,就自己做了个excel,用宏代码修改。 代码如下: Private Sub CommandButton1_Click() Dim varFileList As ...
  • 关注表哥公众号的读者朋友们大家都了解我是最爱“偷懒”的,我说的偷懒当然指的是:『合理偷懒』今天给大家介绍一种批量获取同一文件夹下所有的文件名称的巧妙办法,能够帮忙我们合理偷懒,这也是我在工作实践中无意...
  • 文件夹所有文件的名称,存在在excel中程序案例:程序案例:Private Sub CommandButton1_Click()Application.ScreenUpdating = FalseApplication.DisplayAlerts = Falsetemp = ThisWorkbook.Path '设定路径object...
  • 获取文件夹下文件名,使用VBA处理难度并不大,但是获取全部(包括子文件夹)就难倒了很多新手!今天我们就使用Python和VBA一起来看看如何获取全部文件名VBA 获取全部文件名(含子文件夹)子文件夹可能还有子文件夹,...
  • ExcelVBA获取用户选择的文件名

    千次阅读 2020-02-28 22:06:28
    如果需要对用户指定的文件进行操作,可以使用GetOpenFilename方法打开Excel内置的【打开】对话框,获取用户选择的文件名,此过程并不需要真正打开文件,示例代码如下。 Sub SelectFile() Dim vntFilename As ...
  • 将某文件夹下文件夹的名称导入到excel表中,语言是VBA
  • '读取当前文件夹下txt文件的文件名,写入sheet1的第一列 Dim r As Long Dim Fso As Object Dim myfile As Object Dim mySheet As Worksheet Dim txtFolder As Object r = 1 Set txtFolder = CreateObject("S...
  • excel vba 自动读取文件名文件夹
  • 本次所讲的遍历获取文件夹下所有文件,其实是我的《每月自动汇总考勤数据》案例中的其中一个知识点,近期我将会集中将本案例中所有应用到的知识点逐一的写出来,最后汇总成一个真正可用的成品。 本案例中首要的...
  • VBA--遍历文件夹下所有文件--模板

    千次阅读 2019-03-27 17:57:53
    遍历文件夹下所有文件并输出文件名 Sub OpenAndClose() Dim MyFile As String Dim Arr(1000) As String Dim count As Integer MyFile = Dir("C:\Users\mikowoo\Desktop\EPSreport\result\" & "*.xlsx") ...
  • 一、问题工作需要将多个小的excel文件合并成为一个excel文件,文件格式、内容一致,因为文件数目较多,不考虑... 图1 同一个文件夹下的多个excel文件二、代码Sub 打开文件夹下所有文件并复制制定内容()Dim a$, n As...
  • vb程序,提取制定文件夹下所有类型的文件名,倒入到电子表格
  • if (System.IO.Directory.Exists("D:/notes")) { String[] year = Directory.GetDirectories("D:/notes/"); String[] file = Directory.GetFiles("D:/notes/"...
  • Sub open_file() filenameobj = Application.GetOpenFilename("Excel(*.xls, *.xlsx),*.xls,*.xlsx") MsgBox filenameobj End Sub 参考 https://blog.csdn.net/henryghx/article/details/26973319
  • *.xlsx", MultiSelect:=True) If UBound(fileToOpen) <> 0 Then For i = 1 To UBound(fileToOpen) filePaths = Split(fileToOpen(i), delimiter:="\") Debug.Print "打开的文件的文件名:" & filePaths(UBound...

空空如也

空空如也

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

vba获取文件夹下的所有文件名