ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 417|回复: 8

遍历文件,如何判断(跳过)"拒绝的权限"文件?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-6-20 07:10 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 ning84 于 2024-6-20 07:20 编辑

image.png



  1. Function FindAllFiles(sFolder As Folder)

  2.     Dim oFile As file
  3.     Dim oFld As Folder
  4.     For Each oFile In sFolder.Files                      '遍历目录下所有文件
  5.         With oFile
  6.             Debug.Print .Name, .Type
  7.             If .Type Like "JPG" Then
  8.                  Range("U" & i).Value = .DateLastAccessed                 '将文件路径及文件名填充到表的A列
  9.                  Range("V" & i).Value = .Name                 '将文件路径及文件名填充到表的A列
  10.                  Range("W" & i).Value = .Path                '将文件路径及文件名填充到表的A列
  11.             End If
  12.             i = i + 1
  13.         End With
  14.     Next

  15.     For Each oFld In sFolder.SubFolders              '遍历子文件夹
  16.         FindAllFiles oFld                            '嵌套调用自身
  17.     Next
  18.     Range("R" & i).Value = Format(Time - T, "h:mm:ss")
  19.     Range("R" & i + 1).Value = sFolder.Path
  20. End Function
复制代码




权限被否定(错误 70)
请参阅     特性

试图对写保护的磁盘进行写操作,或要访问加锁文件。此错误有以下的原因和解决方法:

为顺序 Output 或 Append 写,打开一个写保护文件。
用 Input 方式打开文件,或者修改文件的写保护属性。

用顺序 Output 或 Append 方式,打开有写保护的磁盘上的文件。
从磁盘上删除写保护,或者使用 Input 方式文件。

写入已被其他进程锁定的文件。
等其他进程释放后再打开此文件。

试图访问注册表,但用户权限不包括此类注册表访问。
在 32 位 Microsoft Windows 系统上,用户必须有访问当前系统注册表的权限。改变用户权限,或由系统管理员来修改。

详细信息,可选取有问题的项目,并按下 F1 (在Windows中)或HELP(在Macintosh中)键。

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-6-20 08:16 | 显示全部楼层


image.png

image.png


遍历13万多个 文件,用时5分钟多。

  1. '在模块1中输入如图代码:
  2. Public i, T

  3. Function FindAllFiles(sFolder As Folder)

  4.     Dim oFile As file
  5.     Dim oFld As Folder
  6.     On Error Resume Next
  7.     For Each oFile In sFolder.Files                      '遍历目录下所有文件
  8.         With oFile
  9.             'Debug.Print .Name, .Type
  10.             'If .Type Like "JPG" Then
  11.                  Range("U" & i).Value = .DateLastAccessed                 '将文件路径及文件名填充到表的A列
  12.                  Range("V" & i).Value = .Name                 '将文件路径及文件名填充到表的A列
  13.                  Range("W" & i).Value = .Path                '将文件路径及文件名填充到表的A列
  14.             'End If
  15.             i = i + 1
  16.         End With
  17.     Next

  18.     For Each oFld In sFolder.SubFolders              '遍历子文件夹
  19.         FindAllFiles oFld                            '嵌套调用自身
  20.     Next
  21.     Range("R" & i).Value = Format(Time - T, "h:mm:ss")
  22.     Range("R" & i + 1).Value = sFolder.Path
  23. End Function



  24. Sub 遍历选定目录()
  25.     Dim Rng As Range
  26.         Set Rng = Selection
  27.     Dim Arr, Str
  28.     Dim Sht As Worksheet
  29.         Set Sht = Rng.Parent
  30.         With Sht.Cells
  31.             .Clear
  32.             .Font.Size = 9
  33.         End With
  34.         T = Time
  35.     Dim Fso As New FileSystemObject
  36.     Dim sFolder As Folder, sPath As String
  37.         i = 5                                            '初始化
  38.         ii = i
  39.         Range("V:AA").ClearContents
  40.         For kk = 0 To UBound(Arr)
  41.             If Fso.FolderExists(Arr(kk)) Then                      '判断文件是否存在
  42.                Set sFolder = Fso.GetFolder(Arr(kk))
  43.                FindAllFiles sFolder                             '调用函数
  44.            End If
  45.         Next kk
  46.         Set Rng = Sht.Range("U" & ii & ":W" & i - 1)
  47.         Debug.Print Rng.Address
  48.         Str = "=""Traverse All File:"" & " & "Count( " & Rng(, 1).Resize(Rng.Rows.Count, 1).Address(0, 0) & ")"
  49.         
  50.         Debug.Print Str
  51.         With Sht
  52.             .Cells(1, 1) = Str
  53.             .Cells(1, 4) = Format(Time - T, "h:mm:ss")
  54.             .Cells(4, 1) = "=" & Rng.Address(0, 0)
  55.         End With
  56.         
  57. End Sub

复制代码


a.rar

1.88 MB, 下载次数: 5

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-6-23 05:58 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
  1. Public DictFolder As Dictionary, DictFolder1 As Dictionary
  2. Function TraverseFolderDelBlankFolder(sFolder As Folder)
  3.     Dim oFld As Folder
  4.     Dim oArr
  5.     ''
  6.     For Each oFld In sFolder.SubFolders              '遍历子文件夹
  7.         With oFld
  8.            'Debug.Print InStr(.Path, "System Volume Information"), .Path,
  9.            
  10.            If InStr(.Name, "System Volume Information") = 0 Then
  11.                If .Files.Count = 0 And .SubFolders.Count = 0 Then
  12.                    Debug.Print .Path, .Files.Count, .SubFolders.Count
  13.                    'Stop
  14.                    oFld.Delete True
  15.                Else
  16.                    oArr = Array(.Path, .SubFolders.Count, .Files.Count)
  17.                    DictFolder(.Path) = oArr ' Array(.Path, .SubFolders.Count, .Files.Count)
  18.                    'Stop
  19.                   
  20.                    'DictFolder1(.Path) = .SubFolders.Count
  21.                    'Debug.Print .Files.Count, .SubFolders.Count
  22.                    If InStr(.Name, "System Volume Information") = 0 Then
  23.                          TraverseFolderDelBlankFolder oFld                            '嵌套调用自身
  24.                    End If
  25.                   
  26.                End If
  27.            End If
  28.         End With
  29.     Next
  30. End Function

  31. Private Sub delFolder()
  32.        Set DictFolder = New Dictionary
  33.        Set DictFolder1 = New Dictionary
  34.    Dim Rng As Range
  35.        Set Rng = Selection
  36.    Dim Sht As Worksheet
  37.        Set Sht = Rng.Parent
  38.    Dim Arr, tArr
  39.      Arr = Array("C:", "D:", "E:", "F:")
  40.      Arr = Array("e:")
  41.      'Arr = Array("D:", "E:", "F:")
  42.    
  43.    Dim Rr, Cc
  44.        Rr = 10
  45.        Cc = 1
  46.       
  47.        With Sht
  48.             .Cells.Clear
  49.             .Cells.Font.Size = 9
  50.             tArr = Array("oFolderPath", "SubFolderCount", "FilesCount")
  51.             .Cells(Rr, Cc).Resize(, UBound(tArr) + 1) = tArr
  52.        End With
  53.        ''
  54.    Dim Fso As FileSystemObject
  55.        Set Fso = New FileSystemObject
  56.    Dim Folder As Folder
  57.       For ii = 0 To UBound(Arr)
  58.            TraverseFolderDelBlankFolder Fso.GetFolder(Arr(ii))
  59.       Next ii
  60.       ''
  61.       'Debug.Print DictFolder.Count

  62.       With WorksheetFunction
  63.            'Sht.Cells(Rr + 2, Cc).Resize(DictFolder.Count, 3) = .Transpose(.Transpose(DictFolder.Items))
  64.            With DictFolder
  65.               For ii = 0 To DictFolder.Count - 1
  66.                  For jj = 0 To UBound(.Items(0))
  67.                       Sht.Cells(Rr + 2 + ii, Cc + jj) = .Items(ii)(jj)
  68.                       If jj = 0 Then
  69.                           Sht.Cells(Rr + 2 + ii, Cc + jj).Hyperlinks.Add Sht.Cells(Rr + 2 + ii, Cc + jj), .Items(ii)(jj)
  70.                       End If
  71.                  Next jj
  72.               Next ii
  73.            End With
  74.            
  75.            'Sht.Cells(Rr + 2, Cc).Resize(DictFolder.Count, 1) = .Transpose(DictFolder.Keys)
  76.            'Sht.Cells(Rr + 2, Cc + 1).Resize(DictFolder.Count, 1) = .Transpose(DictFolder1.Items)
  77.            'Sht.Cells(Rr + 2, Cc + 2).Resize(DictFolder.Count, 1) = .Transpose(DictFolder.Items)
  78.       End With
  79. End Sub

复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-6-23 20:02 | 显示全部楼层


VB 遍历文件,经常出现如下提示。
964d193a99e4facf3275a83c953096fe_070914vsml0g0gmrsa5grx.png


Documents and Settings文件夹被锁打不开怎么办-百度经验  https://jingyan.baidu.com/article/c910274bc7530acd361d2dca.html


Documents and Settings属于系统保护文件,默认情况是隐藏的且拒绝读取,平时显示时文件件上还带有一把小锁!但是有时候我们需要对文件夹进行清理,必须进去怎么办呢,即使你是administrator也拒绝访问!



system volume information是什么?怎么删除教程-电脑知识-U盘量产网  https://www.upantool.com/sense/2017/10767.html

电脑内存空间不足,我们在清理磁盘文件时,经常会看到“system volume information”文件夹,而且占用的空间还大。那么“system volume information”到底是什么呢?能删除吗?怎么删除?
    system volume information是windows系统文件夹,中文名称可以翻译为"系统卷标信息"。系统还原的备份信息就是保存在这个文件夹里的。
    通常System Volume Information 文件夹是一个隐藏的系统文件夹,"系统还原"工具使用该文件夹来存储它的信息和还原点。随着用户使用系统时间的增加,还原点会越来越多,导致硬盘空间越来越少,最后还要被警告"磁盘空间不足"。
    System Volume Information是在你的硬盘分区格式为NTFS的情况下才会出现,现在电脑一般都是几百G的大硬盘,FAT32格式又不支持大硬盘,所以一般的大硬盘都采用NTFS格式分区,在这种情况下,即使你删除了它,系统还会自动生成,因为这是NTFS分区必须要的文件夹。所以不建议大家删除,你可以在文件夹选项里勾选“隐藏受保护的操作系统文件”,自然就看不到了。
    System Volume Information 除了是系统文件夹外,还有可能是木马病毒。利用"System Volume Information"文件夹自动生成的原理,进行线程插入免杀下载器到自动生成"System Volume Information"文件夹的系统进程里面,然后把加壳加密的木马下载到"System Volume Information"文件夹。在"System Volume Information"文件夹的保护下,杀毒软件无权查杀该木马。在设定条件下夺取SYSTEM权限运行木马预运行模块查杀杀软,然后再脱壳解密启动木马,启用保护进程防止该目录被删。此类木马无法手工删除,杀软无权查杀,就算FAT32的分区也由于加密原因无法脱壳。
    那么“system volume information”该怎么删除呢?
    我们分两部分来介绍怎么删除“system volume information”。

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-6-24 04:20 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
$RECYCLE.BIN

$RECYCLE.BIN是什么文件夹?$RECYCLE.BIN可以删除吗? - 系统之家  https://www.xitongzhijia.net/xtjc/20170926/107979.html


$RECYCLE.BIN是什么文件夹?虽然$RECYCLE.BIN文件夹删除之后没有多大的影响,但笔者依然想说,这个文件夹是无辜的,TA没有做任何不利计算机的事,该文件纯粹是回收站的一个资源占用文件夹。



$RECYCLE.BIN是什么文件夹?
  $RECYCLE.BIN文件夹是系统重要的隐藏文件,一般存在于磁盘根目录下。是系统“回收站”在每一个磁盘上的链接文件夹,用于保存磁盘上删除的文件或者文件夹信息,我们恢复误删除到回收站中的文件或者文件夹时大有用处。一般我们设置显示磁盘的隐藏文件后,才能看到它。
  Win Vista以前Windows系统,该文件夹名称为:Recycle ;Win Vista(Win7/8)以后系统一般名称为$RECYCLE.BIN 。
$RECYCLE.BIN可以删除吗?
  $RECYCLE.BIN文件夹是正常的系统文件,不是病毒、不用删除的。如果回收站设置成“删除文件时不进入回收站”,该文件夹是可以删除的,而且会自动恢复!
  这里还要提醒大家,显示隐藏文件后,磁盘根目录下还会出现一个System Volume Information文件夹,它是NTFS格式磁盘的系统文件,汉语意思是“系统卷标信息”,用于存储系统还原的备份信息。如果系统开启了系统还原功能,每个盘符根目录下都会生成System Volume Information文件夹。如果强制删除之后,相应磁盘就打不开了!
  以上内容便是关于$RECYCLE.BIN是什么文件夹的解决,$RECYCLE.BIN文件最好不要删除,因为这个文件夹是用户删除文件后保留文件信息的位置,每个盘符都有这个这样的文件。

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-6-24 07:26 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册



10个回答#热议# 不吃早饭真的会得胆结石吗?
新航道留学问答
2019-03-13 · 百度知道视频达人
关注
00:00 / 00:34
841    评论 分享 举报
velocity_2005 高粉答主
2020-02-02 · 关注我不会让你失望
关注
展开全部
电脑里的Boot是引导的意思。

以system boot(系统引导)为例:

系统引导通常是由一个被称为启动引导程序的特殊代码完成的,它位于系统ROM中,用来完成定位内核代码在外存的具体位置、按照要求正确装入内核至内存并最终使内核运行起来的整个系统启动过程。

该过程中,启动引导程序要完成多个初始化过程,当这些过程顺利完成后才能使用系统的各种服务。这些过程包括初始引导、内核初始化、全系统初始化。



image.png

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-6-24 07:34 | 显示全部楼层



image.png



msocache是什么文件夹
iteye_3759于 2014-04-06 18:13:00 发布阅读量1k[url=] 收藏[/url]点赞数









  这是Offiece的本地安装源 (Msocache)。“本地安装源”是一种安装功能,它将安装源文件从 Microsoft Office 2003 安装媒体(例如 Office 2003 光盘)复制到 Msocache 文件夹。一般情况,采用NTFS格式分区的D盘有这样一个文件,且隐藏, 通常有几百兆。当然我们在安装Office 2003的时候就会生出这个文件夹,如果不想生成msocache文件,必须在装光盘里FILESSETUPSETUP.INI文件,把[Cache]那个小节下面的CDCACHE=AUTO修改为CDCACHE=0,保存,然后重新刻盘即可。一般用户不敢删除这个文件,就是不知道是什么类型文件。但是msocache文件到底可不可以删除?

  答案是是可以的。当你安装office之后,删除msocache文件夹具体步骤如下:

  1、单击“开始”,依次指向“所有程序”、“附件”、“系统工具”,然后单击“磁盘清理”。

  2、在“选择驱动器”对话框中的“驱动器”列表中,单击“C:”,然后单击“确定”。

  3、等待磁盘清理工具完成对该驱动器的检查。

  4、在“要删除的文件”列表中,单击以选中“Office 安装文件”复选框,然后单击“确定”。(注意:如果 Office 安装文件的大小为零,则 Office 安装文件位于另一硬盘上)。

  5、询问是否删除时消息时,请单击“是”这样就删除了该文件。




TA的精华主题

TA的得分主题

 楼主| 发表于 2024-7-31 04:46 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

简化

  1. Public DictFile As Dictionary
  2. Public i, T

  3. Function FindAllFiles(sFolder As Folder)

  4.     Dim oFile As file
  5.     Dim oFld As Folder

  6.     For Each oFile In sFolder.Files                      '遍历目录下所有文件
  7.         With oFile
  8.            'Debug.Print .Name, .Type, .ParentFolder.Path
  9.            DictFile(.Path) = Array(Format(.DateLastModified, "yyyy年"), Format(.DateLastModified, "yyyy年mm月"), Format(.DateLastModified, "yyyy年mm月dd日"), .DateLastModified, .Name, Round(.Size / 1024 ^ 2, 1), .Type, oStr, 1, .ParentFolder.Path, "", "", "", "", "")
  10.         End With
  11.     Next

  12.     For Each oFld In sFolder.SubFolders
  13.         FindAllFiles oFld
  14.     Next
  15. End Function



  16. Sub T()
  17.     T = Time
  18.     Set DictFile = New Dictionary
  19.         
  20.     Dim Arr, Str
  21.     Dim Sht As Worksheet
  22.         Set Sht = Sheet1
  23.         With Sht.Cells
  24.             .Clear
  25.             .Font.Size = 9
  26.         End With
  27.         T = Time
  28.     Dim Fso As New FileSystemObject
  29.         Set Fso = New FileSystemObject
  30.     Dim sFolder As Folder, sPath As String
  31.         FindAllFiles Fso.GetFolder("F:\JPGMP4Office")
  32.         Debug.Print DictFile.Count
  33.     Dim Rng As Range
  34.         
  35.         With WorksheetFunction
  36.              Sht.Cells(15, 1).Resize(DictFile.Count, 10) = .Transpose(.Transpose(DictFile.Items))
  37.         End With
  38.         
  39.         Sht.Cells(1, "D") = Format(Time - T, "h:mm:ss")
  40.         Stop
  41.         Stop
  42. End Sub


复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-8-1 23:18 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

Delete Folder


  1. Function DelFolder(sFolder As Folder)
  2.     Dim oFld As Folder


  3.     For Each oFld In sFolder.SubFolders

  4.         DelFolder oFld
  5.         With oFld
  6.              Debug.Print .Path, .SubFolders.Count, .Files.Count
  7.              If .SubFolders.Count = 0 And .Files.Count = 0 Then
  8.                    .Delete False
  9.                   
  10.              End If
  11.         End With
  12.     Next
  13. End Function



  14. Sub T()
  15.     Dim Fso As New FileSystemObject
  16.         Set Fso = New FileSystemObject
  17.     Dim sFolder As Folder, sPath As String
  18.         DelFolder Fso.GetFolder("F:\JPGMP4Office")
  19. End Sub



复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-18 08:44 , Processed in 0.048110 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表