乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 50|回复: 4

目录列表。

[复制链接]

10

主题

34

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
74
发表于 2007-4-27 05:22:46 | 显示全部楼层 |阅读模式
有人能告诉我如何获得目录中所有文件的列表以及其中包含的任何子目录吗?我可以得到根目录中的文件列表,但进入任何子目录都有问题

本帖以下内容被隐藏保护;需要你回复后,才能看到!

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

12

主题

150

帖子

3

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
198
发表于 2007-4-27 07:51:03 | 显示全部楼层
看看VBA文档中的FileSystemObject。它有你需要的一切。或者,您可以使用FindFirstFile和FindNextFile Win32 API函数。
回复

使用道具 举报

10

主题

34

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
74
发表于 2007-4-27 08:09:19 | 显示全部楼层
James Crowley的API代码将API内容添加到顶部的模块中,并通过向表单添加cmdOBrowse_Click()来使用getfiles函数。
这将允许您选择要浏览的文件夹。对不起,太乱了。你得花几分钟来设置它。但它的作用就像一个符咒。查看页面底部,了解使用getfiles函数仅获取dxf文件的示例。我有各种函数,比如这样,用于获取目录中的某些文件。
模块内容
  1. Option Explicit
  2. Private Declare Function apiShellExecute Lib "shell32.dll" _
  3.     Alias "ShellExecuteA" _
  4.     (ByVal hwnd As Long, _
  5.     ByVal lpOperation As String, _
  6.     ByVal lpFile As String, _
  7.     ByVal lpParameters As String, _
  8.     ByVal lpDirectory As String, _
  9.     ByVal nShowCmd As Long) _
  10.     As Long
  11.    
  12. Public Type BROWSEINFO
  13.     hOwner As Long
  14.     pidlRoot As Long
  15.     pszDisplayName As String
  16.     lpszTitle As String
  17.     ulFlags As Long
  18.     lpfn As Long
  19.     lParam As Long
  20.     iImage As Long
  21. End Type
  22. Public Type SHITEMID   'mkid
  23.     cb As Long      'Size of the ID (including cb itself)
  24.     abID As Byte   'The item ID (variable length)
  25. End Type
  26. Type ITEMIDLIST  'idl
  27.     mkid As SHITEMID
  28. End Type
  29. Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  30. Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
  31. Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
  32. Public Const BIF_RETURNONLYFSDIRS = &H1
  33. Public Const BIF_DONTGOBELOWDOMAIN = &H2
  34. Public Const BIF_STATUSTEXT = &H4
  35. Public Const BIF_RETURNFSANCESTORS = &H8
  36. Public Const BIF_BROWSEFORCOMPUTER = &H1000
  37. Public Const BIF_BROWSEFORPRINTER = &H2000
  38. Private Declare Function apiGetSystemDirectory& Lib "Kernel32" _
  39.         Alias "GetSystemDirectoryA" _
  40.         (ByVal lpBuffer As String, ByVal nSize As Long)
  41. Private Declare Function apiGetWindowsDirectory& Lib "Kernel32" _
  42.         Alias "GetWindowsDirectoryA" _
  43.         (ByVal lpBuffer As String, ByVal nSize As Long)
  44. Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer
  45. '***App Window Constants***
  46. Public Const WIN_NORMAL = 1         'Open Normal
  47. Public Const WIN_MAX = 3            'Open Maximized
  48. Public Const WIN_MIN = 2            'Open Minimized
  49. Private Const MAX_PATH As Integer = 255
  50. '***Error Codes***
  51. Private Const ERROR_SUCCESS = 32&
  52. Private Const ERROR_NO_ASSOC = 31&
  53. Private Const ERROR_OUT_OF_MEM = 0&
  54. Private Const ERROR_FILE_NOT_FOUND = 2&
  55. Private Const ERROR_PATH_NOT_FOUND = 3&
  56. Private Const ERROR_BAD_FORMAT = 11&
  57. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
  58.     ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal Cx As Long, _
  59.     ByVal Cy As Long, ByVal wFlags As Long) As Long

表单内容
  1. Option Explicit
  2. Private Sub cmdIBrowse_Click()
  3.   Dim selectFolder As String
  4.   Dim bi As BROWSEINFO
  5.   Dim idl As ITEMIDLIST
  6.   Dim rtn&, pidl&, path$, pos%
  7.   '  set the type of folder to return
  8.   '  play with these option constants to see what can be returned
  9.   bi.ulFlags = BIF_RETURNONLYFSDIRS  'BIF_RETURNFSANCESTORS 'BIF_BROWSEFORPRINTER + BIF_DONTGOBELOWDOMAIN
  10.   
  11.   '  show the browse folder dialog
  12.   pidl& = SHBrowseForFolder(bi)
  13.   
  14.   '  if displaying the return value, get the selected folder
  15. ' If Check1 Then
  16.     path$ = Space$(512)
  17.     rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
  18.     If rtn& Then
  19.       
  20.       '  parce & display the folder selection
  21.       pos% = InStr(path$, Chr$(0))
  22.         selectFolder = Left(path$, pos - 1)
  23.     Else
  24.         selectFolder = ""
  25.     End If
  26. End Sub
  27. Private Sub cmdOBrowse_Click()
  28.   Dim selectFolder As String
  29.   Dim bi As BROWSEINFO
  30.   Dim idl As ITEMIDLIST
  31.   Dim rtn&, pidl&, path$, pos%
  32.   '  set the type of folder to return
  33.   '  play with these option constants to see what can be returned
  34.   bi.ulFlags = BIF_RETURNONLYFSDIRS  'BIF_RETURNFSANCESTORS 'BIF_BROWSEFORPRINTER + BIF_DONTGOBELOWDOMAIN
  35.   
  36.   '  show the browse folder dialog
  37.   pidl& = SHBrowseForFolder(bi)
  38.   
  39.   '  if displaying the return value, get the selected folder
  40. ' If Check1 Then
  41.     path$ = Space$(512)
  42.     rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
  43.     If rtn& Then
  44.       
  45.       '  parce & display the folder selection
  46.       pos% = InStr(path$, Chr$(0))
  47.         selectFolder = Left(path$, pos - 1)
  48.     Else
  49.         selectFolder = ""
  50.     End If
  51. End Sub
  52. Private Sub cmdCancel_Click()
  53.     Unload Me
  54. End Sub
  55. Private Sub cmdGO_Click()
  56. Dim FileCountx As Integer
  57. Dim FilesArray() As String
  58. Dim inpath As String
  59. Dim OutPath As String
  60. Dim teststring1 As String
  61. Dim teststring2 As String
  62. Dim MyFilename As String
  63. Dim MyOldFilename As String
  64. Dim MyNewFilename As String
  65. Dim AddText As String
  66. Dim RemoveText As String
  67. FilesArray = GetFiles(inpath)
  68. FileCountx = -1
  69. For FileCountx = LBound(FilesArray) To UBound(FilesArray)
  70. MsgBox MyFilename
  71. 'open the file, set the active doc and save it, switch the active doc back,
  72. ' open the next and save and so on.
  73. 'you can add code to go to a layout in paperspace/modelspace, zoom
  74. 'extents, whatever you need.
  75. Next
  76. Unload Me
  77. End Sub
  78. Sub Main()
  79. End Sub
  80. Private Sub Form_Load()
  81. Populate
  82. End Sub
  83. Private Sub Populate()
  84. Dim S As String
  85. Dim PathIName As String
  86. Dim SlashPos As Integer
  87. Dim PathOName As String
  88. 'add some form code here
  89.         
  90. End Sub
  91. Function GetFiles(ByVal FullPath As String) As String()
  92.   
  93. Dim FileName As String
  94.   Dim num_files As Integer
  95.   num_files = -1
  96.   Dim FilesArray() As String
  97.   Dim file_name As String
  98.   If Right(FullPath, 1)  "" Then FullPath = FullPath & ""
  99.   FullPath = FullPath & "*.*"
  100.   file_name = Dir(FullPath, vbNormal)
  101.   Do While Len(file_name) > 0
  102.      If FileName  "." And FileName  ".." Then  ' "" Then FullPath = FullPath & ""
  103.   FullPath = FullPath & "*.*"
  104.   file_name = Dir(FullPath, vbNormal)
  105.   Do While Len(file_name) > 0
  106.      If FileName  "." And FileName  ".." Then
  107.         
  108.         If Right(file_name, 3) = "dxf" Then
  109.             num_files = num_files + 1
  110.             ReDim Preserve FilesArray9(0 To num_files)
  111.             FilesArray9(num_files) = file_name
  112.         Else
  113.         
  114.         GoTo skip
  115.         End If
  116.         
  117.      End If
  118.     ' Get the next file.
  119. skip:
  120.     file_name = Dir$()
  121.   Loop
  122.   GetDxfFiles = FilesArray9
  123.   
  124.   'the array is filled

回复

使用道具 举报

12

主题

150

帖子

3

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
198
发表于 2007-4-27 08:36:13 | 显示全部楼层
非常感谢您的参与。我现在设法让事情进展顺利。只需要一点微调,但上述信息已经帮助了我很多。
回复

使用道具 举报

12

主题

150

帖子

3

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
198
发表于 2007-4-27 08:38:58 | 显示全部楼层
酷,我很高兴你能解决这个问题。
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-7 18:28 , Processed in 1.277631 second(s), 62 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表