Solved

File Names

Posted on 2001-07-30
11
180 Views
Last Modified: 2012-05-04
I am trying to get a list of file names to a text file.
For example:  
I know the dir is c:\send
I just want the names of the files put in a text file.

The only way I know how to do this is by a shell command and I don't wish to use that.
0
Comment
Question by:discgolfam
  • 4
  • 2
  • 2
  • +3
11 Comments
 
LVL 44

Expert Comment

by:Arthur_Wood
ID: 6335944
You can use the Dir function in VB recursively, to retrieve the names of all of the files in the Directory, and then by Opening a text file using either to VB Open and Write functions, or the FileSystemObject, you can write the names of the files to the output file.
0
 
LVL 8

Expert Comment

by:DennisBorg
ID: 6335968
The following routine should work:

Sub CreateDirectoryFile(ByVal sDir As String, ByVal sFileName As String)
   Dim hFile   As Integer
   Dim CurFile As String

   If Right(sDir,1)<>"\" Then sDir = sDir & "\"
   hFile = FreeFile()
   Open sFileName For Output As #hFile

   CurFile = Dir(sDir & "*.*")
   Do While Len(CurFile)
      Print #hFile, CurFile
      CurFile = Dir()
   Loop
   Close #hFile
End Sub


-Dennis Borg
0
 
LVL 5

Expert Comment

by:GeoffKell
ID: 6335973
Arthur - one of the weaknesses of the VB Dir function is that it cannot be called recursively. I would recommend the FileSystemObject method or the FindFile API calls.

If you wish to pursue the use of the VB Dir function then I answered a similar question last week on this which may be fund at

http://www.experts-exchange.com/jsp/qShow.jsp?qid=20158023

Regards
GK
0
 
LVL 8

Expert Comment

by:Dave_Greene
ID: 6335983
Private Sub OutPutFiles(ByVal pstrPath As String)

  Dim objFile As File
  Dim objFolder As Folder
  Dim objFSO As FileSystemObject
 
  Set objFSO = New FileSystemObject
 
  Set objFolder = objFSO.GetFolder(pstrPath)

  Open App.Path & "Text.txt" For Output As #1
 
  For Each objFile In objFolder.Files
      Print #1, objFile.Name
  Next objFile

  Close #1
   
End Sub
0
 
LVL 8

Expert Comment

by:Dave_Greene
ID: 6335986
Syntax  

OutPutFiles "c:\send"
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 44

Accepted Solution

by:
Arthur_Wood earned 50 total points
ID: 6335996
Try this and sse if it gets you what you want:

Private Sub cmdExport_Click()
    Dim iFile As Integer
    Dim strFile As String
   
    iFile = FreeFile
    Open "C:/output.txt" For Output As #iFile
   
    strFile = Dir(txtFilePath & "/*.*")
    Do While strFile <> ""
        Print #iFile, strFile; ",";
        strFile = Dir()
    Loop
    Close #iFile
End Sub

here I have a form, with a Text box (called txtFilePath) and a Command Button (cmdExport).  txtFilePath holds the path of the directory that you want to list (in your case "C:/SEND").

YOu could also use the Write #iFile ,strFile
in place of the Print #ifile,strFile statement show,

Look up the Write # statement in the VB Help system.
0
 
LVL 44

Expert Comment

by:Arthur_Wood
ID: 6336532
Geoff, check the code that I posted.  I may not be calling Dir RECURSIVELY in the strict sense, bu that code does in fact return the names of ALL of the files (not folders) in the indicated folder).  Truem it does NOT traverse the included Folders within a given folder, but the original question did not ask for that.

If in fact, it is desired to traverse the ENTIRE tree strcuture within a given folder, then clearly the FSO is the only game in town.
0
 
LVL 8

Expert Comment

by:DennisBorg
ID: 6336621
>If in fact, it is desired to traverse the ENTIRE tree
>strcuture within a given folder, then clearly
>the FSO is the only game in town.

I would disagree with this concerning the FSO; I still wouldn't use it. I might use the Dir() function, but would probably use the Win API functions.

-Dennis Borg
0
 
LVL 4

Expert Comment

by:nutwiss
ID: 6336994
this code contains a fully recursive file search function:

create a new form with

a DriveListBox   (drvDriveList)
a DirListBox     (dirFolderList)
a listview       (lstvwFatFiles)
a command button (cmdSearch)
a textbox        (txtFIleSize)

dont ask about the control names! - I've just ripped this code out of another project....


Option Explicit

Dim scrFileSys As Scripting.FileSystemObject
Private Sub drvDriveList_Change()
dirFolderList.Path = drvDriveList
End Sub

Private Sub Form_Load()
Set scrFileSys = New Scripting.FileSystemObject
dirFolderList.Path = Left(drvDriveList.Drive, 2) & "\"
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set scrFileSys = Nothing
End Sub

Private Sub cmdSearch_Click()
Dim fldStart As Scripting.Folder
Set fldStart = scrFileSys.GetFolder(dirFolderList.Path)
lstvwFatFiles.ListItems.Clear
FindFiles fldStart, txtFIleSize
End Sub

Private Sub FindFiles(fldSearch As Scripting.Folder, strFileName As String, Optional blnFindFolders As Boolean = True)
Dim fld As Scripting.Folder
Dim fyl As Scripting.File
Dim lngSize As Long
Dim itm As ListItem

    'Recursively Call this Function to Find Files in Sub Folders
    If fldSearch.SubFolders.Count Then
        For Each fld In fldSearch.SubFolders
            If blnFindFolders Then
                With fld
                    If InStr(.Name, strFileName) <> 0 Then
                        Set itm = lstvwFatFiles.ListItems.Add(Text:=.Name)
                        With itm
                            .SubItems(2) = fld.Type
                        End With
                    End If
                End With
            End If
            FindFiles fld, strFileName
        Next fld
    End If
   
    'Add matching files to list
    For Each fyl In fldSearch.Files
        With fyl
            If InStr(.Name, strFileName) <> 0 Then
                Set itm = lstvwFatFiles.ListItems.Add(Text:=.Name)
                lngSize = .Size / 1000
                With itm
                    .SubItems(1) = Format(lngSize, "#,###kB")
                    .SubItems(2) = fyl.Type
                End With
            End If
        End With
    Next fyl
   
    Set itm = Nothing
    Set fld = Nothing
End Sub


0
 
LVL 27

Expert Comment

by:Ark
ID: 6339222
Hi

'====BAS module code=====
Option Explicit
Const MAX_PATH = 260
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_DIRECTORY = &H10

Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Type FOLDER_INFO
   DirSize As Currency
   FilesCount As Long
   DirsCount As Long
End Type

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public sFiles() As String

Public Function GetFolderInfo(sFolder As String, Optional sPattern As String = "*.*") As FOLDER_INFO
   If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
   Dim lFileNum As Long, lDirNum As Long, sTemp As String
   Dim curSize As Currency, FolderQueue As New Collection
   FolderQueue.Add sFolder
   Call EnumFolder(FolderQueue)
   sTemp = FolderQueue.Item(1)
   Call EnumFiles(sTemp, lFileNum, curSize, sPattern)
   FolderQueue.Remove 1
   Do While FolderQueue.Count > 0
      lDirNum = lDirNum + 1
      Call EnumFolder(FolderQueue)
      sTemp = FolderQueue.Item(1)
      Call EnumFiles(sTemp, lFileNum, curSize, sPattern)
      FolderQueue.Remove 1
      DoEvents
   Loop
   GetFolderInfo.DirSize = curSize
   GetFolderInfo.FilesCount = lFileNum
   GetFolderInfo.DirsCount = lDirNum
End Function

Private Sub EnumFolder(FolderQueue As Collection)
   Dim sTemp As String, sFolder As String
   Dim lRet As Long, WFD As WIN32_FIND_DATA
   Dim hFile As Long
   sFolder = FolderQueue.Item(1)
   hFile = FindFirstFile(sFolder & "*.*", WFD)
   If hFile = INVALID_HANDLE_VALUE Then Exit Sub
   sTemp = TrimNulls(WFD.cFileName)
   Do While sTemp <> ""
      If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
         If sTemp <> "." And sTemp <> ".." Then
            If Right$(sTemp, 1) <> "\" Then sTemp = sTemp & "\"
            FolderQueue.Add sFolder & sTemp
         End If
      End If
      lRet = FindNextFile(hFile, WFD)
      sTemp = ""
      If lRet <> 0 Then sTemp = TrimNulls(WFD.cFileName)
   Loop
   lRet = FindClose(hFile)
End Sub

Private Sub EnumFiles(sFolder As String, lFileNum As Long, lngSize As Currency, sPattern As String)
   Dim sTemp As String
   Dim lRet As Long, WFD As WIN32_FIND_DATA
   Dim hFile As Long, n As Integer
   hFile = FindFirstFile(sFolder & sPattern, WFD)
   If hFile = INVALID_HANDLE_VALUE Then Exit Sub
   sTemp = TrimNulls(WFD.cFileName)
   Do While sTemp <> ""
      lngSize = lngSize + WFD.nFileSizeLow
      lFileNum = lFileNum + 1
      n = UBound(sFiles) + 1
      ReDim Preserve sFiles(n)
      sFiles(n) = sFolder & TrimNulls(WFD.cFileName)
      lRet = FindNextFile(hFile, WFD)
      sTemp = ""
      If lRet <> 0 Then sTemp = TrimNulls(WFD.cFileName)
   Loop
   lRet = FindClose(hFile)
End Sub

Private Function TrimNulls(sTemp As String) As String
   Dim l As Long
   l = InStr(1, sTemp, Chr(0))
   If l = 1 Then
      TrimNulls = ""
   ElseIf l > 0 Then
      TrimNulls = Left$(sTemp, l - 1)
   Else
      TrimNulls = sTemp
   End If
End Function

'=====Form code===
Private Sub Command1_Click()
   ReDim sFiles(0)
   Dim l As FOLDER_INFO
   l = GetFolderInfo("c:\windows\system", "*.exe")
   MsgBox "Total  " & l.DirSize & " bytes" & " in " & l.FilesCount & " files at " & l.DirsCount & " Folders"
   Open "c:\FileNames.txt" For Binary As #1
      Put #1,,sFiles
   Close #1
End Sub

Cheers


0
 
LVL 44

Expert Comment

by:Arthur_Wood
ID: 6627092
thank you...glad to help
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now