Author Topic: Directory listing.  (Read 1644 times)

0 Members and 1 Guest are viewing this topic.

mr_nick

  • Guest
Directory listing.
« on: April 27, 2007, 05:22:46 AM »
Could some kind soul please advise me as to how I go about getting a listing of all files held in a directory and any subdirectories contained in there? I can get the list of files in the root directory but am having problems getting into any subdirectories  :oops:

Chuck Gabriel

  • Guest
Re: Directory listing.
« Reply #1 on: April 27, 2007, 07:51:03 AM »
Take a look at FileSystemObject in the VBA docs.  It has everything you need.  Alternatively, you could use the FindFirstFile and FindNextFile Win32 API functions.

DaveW

  • Guest
Re: Directory listing.
« Reply #2 on: April 27, 2007, 08:09:19 AM »
Credit to James Crowley for the API code

Add the API stuff into a module at the top and use the getfiles function by adding cmdOBrowse_Click() to a form.
This will let you choose a folder to browse for. Sorry it's such a mess. You are goign to have to poke around for a few minutes setting it up. It work's like a charm though. Look at the bottom of the page for an example of using the getfiles function to only get dxf files. I have various functions, like this, for getting certain files in a dir.


Module stuff

Code: [Select]
Option Explicit


Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long
   



Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Public Type SHITEMID   'mkid
    cb As Long      'Size of the ID (including cb itself)
    abID As Byte   'The item ID (variable length)
End Type


Type ITEMIDLIST  'idl
    mkid As SHITEMID
End Type

Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000



Private Declare Function apiGetSystemDirectory& Lib "Kernel32" _
        Alias "GetSystemDirectoryA" _
        (ByVal lpBuffer As String, ByVal nSize As Long)

Private Declare Function apiGetWindowsDirectory& Lib "Kernel32" _
        Alias "GetWindowsDirectoryA" _
        (ByVal lpBuffer As String, ByVal nSize As Long)


Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer
'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized
Private Const MAX_PATH As Integer = 255

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
    ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal Cx As Long, _
    ByVal Cy As Long, ByVal wFlags As Long) As Long
Form stuff

Code: [Select]
Option Explicit

Private Sub cmdIBrowse_Click()
  Dim selectFolder As String
  Dim bi As BROWSEINFO
  Dim idl As ITEMIDLIST
  Dim rtn&, pidl&, path$, pos%
  '  set the type of folder to return
  '  play with these option constants to see what can be returned
  bi.ulFlags = BIF_RETURNONLYFSDIRS  'BIF_RETURNFSANCESTORS 'BIF_BROWSEFORPRINTER + BIF_DONTGOBELOWDOMAIN
 
  '  show the browse folder dialog
  pidl& = SHBrowseForFolder(bi)
 
  '  if displaying the return value, get the selected folder
 ' If Check1 Then
    path$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
    If rtn& Then
     
      '  parce & display the folder selection
      pos% = InStr(path$, Chr$(0))

        selectFolder = Left(path$, pos - 1)
    Else
        selectFolder = ""
    End If
End Sub

Private Sub cmdOBrowse_Click()
  Dim selectFolder As String
  Dim bi As BROWSEINFO
  Dim idl As ITEMIDLIST
  Dim rtn&, pidl&, path$, pos%
  '  set the type of folder to return
  '  play with these option constants to see what can be returned
  bi.ulFlags = BIF_RETURNONLYFSDIRS  'BIF_RETURNFSANCESTORS 'BIF_BROWSEFORPRINTER + BIF_DONTGOBELOWDOMAIN
 
  '  show the browse folder dialog
  pidl& = SHBrowseForFolder(bi)
 
  '  if displaying the return value, get the selected folder
 ' If Check1 Then
    path$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
    If rtn& Then
     
      '  parce & display the folder selection
      pos% = InStr(path$, Chr$(0))

        selectFolder = Left(path$, pos - 1)
    Else
        selectFolder = ""
    End If


End Sub
Private Sub cmdCancel_Click()

    Unload Me

End Sub

Private Sub cmdGO_Click()

Dim FileCountx As Integer
Dim FilesArray() As String
Dim inpath As String
Dim OutPath As String
Dim teststring1 As String
Dim teststring2 As String
Dim MyFilename As String
Dim MyOldFilename As String
Dim MyNewFilename As String
Dim AddText As String
Dim RemoveText As String


FilesArray = GetFiles(inpath)


FileCountx = -1

For FileCountx = LBound(FilesArray) To UBound(FilesArray)


MsgBox MyFilename
'open the file, set the active doc and save it, switch the active doc back,
' open the next and save and so on.
'you can add code to go to a layout in paperspace/modelspace, zoom
'extents, whatever you need.

Next




Unload Me


End Sub

Sub Main()


End Sub




Private Sub Form_Load()
Populate
End Sub
Private Sub Populate()

Dim S As String
Dim PathIName As String
Dim SlashPos As Integer
Dim PathOName As String
'add some form code here

       
End Sub

Function GetFiles(ByVal FullPath As String) As String()
 


Dim FileName As String

  Dim num_files As Integer

  num_files = -1
 
  Dim FilesArray() As String
  Dim file_name As String
 
  If Right(FullPath, 1) <> "\" Then FullPath = FullPath & "\"
  FullPath = FullPath & "*.*"
 
  file_name = Dir(FullPath, vbNormal)
  Do While Len(file_name) > 0
     If FileName <> "." And FileName <> ".." Then  '<-----I don't know why FileName works,'
    ' its not dimmed, but it does. I think its a VBA thing. Just insert some code to filter for
    'a certain extention, whatever......see example at bottom of this page......
        num_files = num_files + 1
        ReDim Preserve FilesArray(0 To num_files)
        FilesArray(num_files) = file_name
     End If
    ' Get the next file.
    file_name = Dir$()
  Loop
 
  GetFiles = FilesArray
 
  'the array is filled
 

End Function


Example of getting dxf files. The above that calls getfiles, needs to be changed to getdxffiles if you want to use this insetad.

Code: [Select]
Function GetDxfFiles(ByVal FullPath As String) As String()

  Dim num_files As Integer
  Dim FileName As String
  num_files = -1
 
  'Dim FilesArray() As String
  Dim file_name As String
 
  If Right(FullPath, 1) <> "\" Then FullPath = FullPath & "\"
  FullPath = FullPath & "*.*"
 
  file_name = Dir(FullPath, vbNormal)
  Do While Len(file_name) > 0
     If FileName <> "." And FileName <> ".." Then
       
        If Right(file_name, 3) = "dxf" Then
            num_files = num_files + 1
            ReDim Preserve FilesArray9(0 To num_files)
            FilesArray9(num_files) = file_name
        Else
       
        GoTo skip
        End If
       
     End If
    ' Get the next file.
skip:
    file_name = Dir$()

  Loop
 
  GetDxfFiles = FilesArray9
 
  'the array is filled
« Last Edit: April 27, 2007, 08:27:53 AM by DaveW »

mr_nick

  • Guest
Re: Directory listing.
« Reply #3 on: April 27, 2007, 08:36:13 AM »
Many thanks for the input. I've managed to get things chugging along now. Just need a bit of fine tuning but the above info has helped me out a whole lot.

DaveW

  • Guest
Re: Directory listing.
« Reply #4 on: April 27, 2007, 08:38:58 AM »
Cool, I'm glad you were able to work it out.