[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖
回复 9# ghost-jason

TOP

回复 8# yu2n


    我去大神啊。这个代码这么长还有正则表达式。这个太难了我得慢慢消化。哦对了你能不能给我分析一个代码
  1. Function GetCurrentFolderFullPath  
  2. Set fso = CreateObject("Scripting.FileSystemObject")  
  3. GetCurrentFolderFullPath = fso.GetParentFolderName(WScript.ScriptFullName)  
  4. End Function
  5. '以上代码得到该脚本所在的路径
  6. Function GetSubFolders(currentFolderFullPath)  
  7.     Set fso = CreateObject("Scripting.FileSystemObject")  
  8.     Set currentFolder = fso.GetFolder(currentFolderFullPath)  
  9.     Set subFolderSet = currentFolder.SubFolders  
  10.     For Each subFolder in subFolderSet  
  11.         'MsgBox "subFolder.Path=" & subFolder.Path   
  12.         GetSubFolders =subFolder.Path  & vbcrlf  & GetSubFolders &  
  13. GetSubFolders(subFolder.Path)   
  14.          Next  
  15. End Function  
  16. MsgBox GetSubFolders(GetCurrentFolderFullPath)
复制代码

TOP

给你个……
  1. ' +----------------------------------------------------------------------------+
  2. ' | 递归查找文件类:可自定义扫描目录层数、文件类型 |
  3. ' +----------------------------------------------------------------------------+
  4. Class Scan_Folder
  5.     ' ==============================================================================================================
  6.     ' 类初始化
  7.     ' ==============================================================================================================
  8.     ' 公共变量
  9.     Private fso, regEx, sFolderSpec, sParentFolderLayer, sMaxLayer, sFileType_RegExPatternt, sFileType, sFileList, sFolderList, sEmptyFolderList
  10.     Private Scan_Folder_Only, Scan_Folder_Sub
  11.     '类初始化事件
  12.     Private Sub Class_Initialize
  13.         Set fso = CreateObject("Scripting.FileSystemObject")
  14.         Set regEx = CreateObject("VBScript.RegExp")     ' 建立正则表达式。
  15.             regEx.IgnoreCase = True     ' 设置是否区分大小写。
  16.             regEx.Global = True         ' 设置全局替换。
  17.             regEx.MultiLine = True      ' 设置多行匹配模式
  18.         Scan_Folder_Only = True           ' 仅扫描文件夹(提高效率)
  19.         Scan_Folder_Sub = True            ' 扫描子文件夹
  20.     End Sub
  21.     ' ==============================================================================================================
  22.     ' 获取设定
  23.     ' ==============================================================================================================
  24.     ' 设置扫描目录
  25.     Public Function FolderSpec(ByVal strFolderSpec)
  26.         sFolderSpec = strFolderSpec
  27.     End Function
  28.     ' 设置最大扫描目录层数
  29.     Public Function MaxLayer(ByVal strMaxLayer)
  30.         sMaxLayer = strMaxLayer
  31.     End Function
  32.     ' 设置扫描的文件类型
  33.     Public Function FileType_RegExPatternt(ByVal strFileType_RegExPatternt)
  34.         sFileType_RegExPatternt = strFileType_RegExPatternt
  35.     End Function
  36.     ' 获取文件夹列表(包括空文件夹)
  37.     Public Function GetFolderList()
  38.         Scan_Folder_Only = True
  39.         Scan_Layer sFolderSpec
  40.         GetFolderList = sFolderList
  41.     End Function
  42.     ' 获取空文件夹列表
  43.     Public Function GetEmptyFolderList()
  44.         Scan_Folder_Only = False
  45.         Scan_Layer sFolderSpec
  46.         GetEmptyFolderList = sEmptyFolderList
  47.     End Function
  48.     ' 获取文件列表
  49.     Public Function GetFileList()
  50.         Scan_Folder_Only = False
  51.         Scan_Layer sFolderSpec
  52.         GetFileList = sFileList
  53.     End Function
  54.     ' 关闭控件
  55.     Public Sub Close()
  56.         Set fso = Nothing
  57.         Set regEx = Nothing
  58.     End Sub
  59.     ' ==============================================================================================================
  60.     ' 私有函数
  61.     ' ==============================================================================================================
  62.     ' 递归扫描
  63.     Private Function Scan_Layer(strFolderspec)
  64.         On Error Resume Next
  65.         If Not Right(strFolderspec,1) = "\" Then strFolderspec = strFolderspec & "\"
  66.         If Not IsEmpty(sFolderList) Then sFolderList = sFolderList & vbCrLf
  67.         sFolderList = sFolderList & strFolderspec
  68.         ' 文件夹对象
  69.         Dim oFolder, oSubFolderItems, oSubFileItems, oSubFolder, oSubFile
  70.         Set oFolder = fso.GetFolder(strFolderspec)
  71.         ' 是否扫描 当前文件夹 的 子文件
  72.         If Scan_Folder_Only = False Then
  73.             ' 子文件对象集合
  74.             Set oSubFileItems = oFolder.Files
  75.             ' 查找当前文件夹 的 文件
  76.             If oSubFileItems.Count <> 0 Then
  77.                 For Each oSubFile In oSubFileItems
  78.                     If IsEmpty(sFileType_RegExPatternt) Or (sFileType_RegExPatternt = "") Then
  79.                         If Not IsEmpty(sFileList) Then sFileList = sFileList & vbCrLf
  80.                         sFileList = sFileList & oSubFile.Path
  81.                     Else
  82.                         ' 过滤文件类型(适用正则表达式)
  83.                         regEx.Pattern = sFileType_RegExPatternt
  84.                         If regEx.Execute( fso.GetExtensionName(oSubFile) ).Count > 0 Then
  85.                             If Not IsEmpty(sFileList) Then sFileList = sFileList & vbCrLf
  86.                             sFileList = sFileList & oSubFile.Path
  87.                         End If
  88.                     End If
  89.                 Next
  90.             End If
  91.         End If
  92.         ' 查找当前文件夹 的 子文件夹
  93.         Set oSubFolderItems = oFolder.SubFolders        ' 子文件夹对象集合
  94.         ' --------没有子文件夹时
  95.         If oSubFolderItems.Count = 0 Then
  96.             ' --------也没有子文件时(此文件夹为空)
  97.             If Scan_Folder_Only = False Then
  98.                 If oSubFileItems.Count = 0 Then
  99.                     If Not IsEmpty(sEmptyFolderList) Then sEmptyFolderList = sEmptyFolderList & vbCrLf
  100.                     sEmptyFolderList = sEmptyFolderList & strFolderspec
  101.                 End If
  102.             End If
  103.         Else
  104.             ' 限制递归的最大层数
  105.             If Not (IsEmpty(sMaxLayer) Or (sMaxLayer = "")) Then
  106.                 Dim s, f, n
  107.                 s = Replace(strFolderspec, sFolderSpec, "", vbTextCompare, -1, 1)
  108.                 f = "\"
  109.                 n = (Len(s)-Len(Replace(s,f,"",vbTextCompare,-1,1)))/Len(f)    ' 统计字符串中某一单词出现次数
  110.                 If sMaxLayer < n Then Scan_Folder_Sub = False
  111.             Else
  112.                 Scan_Folder_Sub = True
  113.             End If
  114.             If Scan_Folder_Sub = True Then
  115.                 ' ----有子文件夹时,递归查找
  116.                 For Each oSubFolder In oSubFolderItems
  117.                     'sFolderList = sFolderList & oSubFolder.Path & vbCrLf
  118.                     Scan_Layer oSubFolder.Path
  119.                 Next
  120.             End If
  121.         End If
  122.     End Function
  123. End Class
  124. ' 实例
  125. Sub Demo(ByVal strFolderPath)
  126.     Dim oScanDir, sFileList, sFolderList
  127.     ' 创建对象
  128.     Set oScanDir = New Scan_Folder
  129.     ' 指定文件夹
  130.     oScanDir.FolderSpec strFolderPath
  131.     ' 设定扫描最大层数(可为空。默认扫描所有子文件夹)
  132.     'oScanDir.MaxLayer 2
  133.     ' 指定文件类型(可为空。正则表达式规则,默认则返回所有文件)
  134.     oScanDir.FileType_RegExPatternt "(jpg|mp4)"
  135.     ' 获取结果(必填。GetFileList返回文件列表,GetFolderList返回目录列表,GetEmptyFolderList返回空目录列表)
  136.     sFileList = oScanDir.GetFileList
  137.     sFolderList = oScanDir.GetFolderList
  138.     ' 结束对象
  139.     oScanDir.Close
  140.     ' 对返回的结果进行操作(这里是获取属性)
  141.     Set fso = CreateObject("Scripting.FileSystemObject")
  142.     arrFilePath = Split(sFileList, vbCrLf, -1, vbTextCompare)
  143.     For i = 0 To UBound(arrFilePath)
  144.         strFilePath = arrFilePath(i)
  145.         WScript.Echo "所在目录: " & fso.GetFile(strFilePath).ParentFolder
  146.         WScript.Echo "名称: " & fso.GetFile(strFilePath).Name
  147.         WScript.Echo "大小: " & fso.GetFile(strFilePath).Size
  148.         WScript.Echo "最后修改时间: " & fso.GetFile(strFilePath).DateLastModified
  149.     Next
  150. End Sub
复制代码
不要嫌长……
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

回复 6# DAIC


    恩恩。是了。我换了个盘。能行。但是我不想用bat。比如d盘下有一个文件夹test而这个test文件夹下还有一个文件夹test1就是d:\test\test1\test2等等
就是这种效果

TOP

回复 5# ghost-jason


    你的D盘是不是光驱?

TOP

回复 4# DAIC

报错了
能不能写个纯vbs脚本的,谢啦

TOP

回复 3# ghost-jason


    把2楼代码保存为test.vbs,执行的时候报错了吗?

TOP

回复 2# DAIC


    谢啦。不要bat的。能不能用vbs代码写。遍历的那种

TOP

  1. Dim objShell
  2. Set objShell = CreateObject("WSCript.Shell")
  3. objShell.Run "cmd /k dir D:\"
  4. Set objShell = Nothing
复制代码
Dim objShell
Set objShell = CreateObject("WSCript.Shell")
objShell.Run "cmd /k dir /s D:\"
Set objShell = Nothing

TOP

返回列表