zoukankan      html  css  js  c++  java
  • vba遍历指定的文件夹

    Sub filelist()
    Dim MyName, Dic, Did, i, t, F, TT, MyFileName
           'On Error Resume Next
        Set objShell = CreateObject("Shell.Application")
        Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)
        If Not objFolder Is Nothing Then lj = objFolder.self.Path & ""
        Set objFolder = Nothing
        Set objShell = Nothing
      
        t = Time
        Set Dic = CreateObject("Scripting.Dictionary")    '创建一个字典对象
        Set Did = CreateObject("Scripting.Dictionary")
        Dic.Add (lj), ""
        i = 0
        Do While i < Dic.Count
            Ke = Dic.keys   '开始遍历字典
            MyName = Dir(Ke(i), vbDirectory)    '查找目录
            Do While MyName <> ""
                If MyName <> "." And MyName <> ".." Then
                    If (GetAttr(Ke(i) & MyName) And vbDirectory) = vbDirectory Then    '如果是次级目录
                        Dic.Add (Ke(i) & MyName & ""), ""  '就往字典中添加这个次级目录名作为一个条目
                    End If
                End If
                MyName = Dir    '继续遍历寻找
            Loop
            i = i + 1
        Loop
        Did.Add ("文件清单"), ""    '以查找D盘下所有EXCEL文件为例
        For Each Ke In Dic.keys
            MyFileName = Dir(Ke & "*.xls")
            Do While MyFileName <> ""
                Did.Add (Ke & MyFileName), ""
                MyFileName = Dir
            Loop
        Next
        For Each Sh In ThisWorkbook.Worksheets
            If Sh.Name = "XLS文件清单" Then
                Sheets("XLS文件清单").Cells.Delete
                F = True
                Exit For
            Else
                F = False
            End If
        Next
        If Not F Then
            Sheets.Add.Name = "XLS文件清单"
        End If
        Sheets("XLS文件清单").[A1].Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys)
        TT = Time - t
        MsgBox Minute(TT) & "" & Second(TT) & ""
    End Sub
  • 相关阅读:
    springmvc @ResponseBody返回json 报406 not acceptable
    Java连接mysql中遇到的一些问题及解决方法
    nginx + keepalive 实现高可用
    nginx 内置变量
    nginx 防盗链
    nginx 跨域设置
    nginx 跨域设置
    nginx 日志分割
    servlet 下载地址 jcp
    图片压缩 jdk 1.8兼容问题
  • 原文地址:https://www.cnblogs.com/hofmann/p/12427080.html
Copyright © 2011-2022 走看看