Dosya ve Klasörleri Listeleme

 
Public nodename As String


Public Sub LogPath(strPARENT As String)
Dim gotfiles As Integer
Dim i As Integer
Dim cnt As Integer
Dim lngTopIndex As Long
Dim lngPathIndex As Long
Dim strNextPath As String
Dim nodx As Object
Dim strtsrch As Integer
Dim srchstr As String
Dim strPaths(0) As String

Set objFSO = New FileSystemObject

If Not objFSO.FolderExists(strPARENT) Then Exit Sub

lngTopIndex = 0
lngPathIndex = 0
lngFNAMEScntr = 0
cnt = 1

strPaths(0) = IFBACKSLASH(strPARENT)



frmgetfiles.TV.LineStyle = tvwRootLines
i = objFSO.GetFolder(strPaths(lngPathIndex)).SubFolders.Count

Set objFolders = objFSO.GetFolder(strPaths(lngPathIndex)).SubFolders
For Each objFolder In objFolders

On Error Resume Next

If firstpass = 0 Then
Set nodx = frmgetfiles.TV.Nodes.Add(nodename, tvwChild, frmgetfiles.cmbdrives.Text & "\" & objFolder.Name, objFolder.Name)
firstpass = 1
DoEvents
Else
Set nodx = frmgetfiles.TV.Nodes.Add(nodename, tvwChild, nodename & "\" & objFolder.Name, objFolder.Name)
DoEvents
End If


Next objFolder
On Error GoTo errorhandler

strtsrch = InStr(1, frmgetfiles.cmbfiletypes.Text, "*") + 2
If Not Mid(frmgetfiles.cmbfiletypes.Text, strtsrch, 1) = "*" Then
srchstr = Mid(frmgetfiles.cmbfiletypes.Text, strtsrch, 3)
Else
srchstr = "*"
End If


Set objFiles = objFSO.GetFolder(strPaths(lngPathIndex)).Files
frmgetfiles.lstfiles.Clear
For Each objFile In objFiles

If UCase(Right(objFile.Path, 3)) = UCase(srchstr) Or srchstr = "*" Then
DoEvents
frmgetfiles.lstfiles.AddItem objFile.Name
End If
Next objFile


exitit:
gotfiles = 0


errorhandler:
frmgetfiles.Enabled = True
End Sub

Private Function IFBACKSLASH(strX As String) As String
IFBACKSLASH = IIf(Right(strX, 1) = "\", strX, strX & "\")
End Function

Private Sub cmbdrives_Click()
Screen.MousePointer = 11
firstpass = 0
frmgetfiles.TV.Nodes.Clear
nodename = Me.cmbdrives.Text
Set nodx = frmgetfiles.TV.Nodes.Add(, , nodename, nodename)
LogPath nodename
frmgetfiles.TV.Nodes.Item(nodename).Expanded = True
DoEvents
Screen.MousePointer = 0
End Sub


Private Sub cmbfiletypes_Click()
LogPath nodename
End Sub


Private Sub cmdclose_Click()
Unload Me
End Sub

Private Sub Command1_Click()

End Sub

Private Sub cmdsave_Click()
For i = 0 To frmgetfiles.lstfiles.ListCount - 1
If frmgetfiles.lstfiles.Selected(i) = True Then
'use the following line to save each file name to where ever you are storing these filenames
'Example:
MsgBox nodename & "\" & frmgetfiles.lstfiles.List(i)
End If
Next i
End Sub


Private Sub Form_Load()
Dim itype As Long
Dim i As Integer
Dim tmpdrive As String
Dim found As Boolean
Dim fs As FileSystemObject
Dim drv As Drive

Set fs = CreateObject("scripting.filesystemobject")

For i = 65 To 90
On Error Resume Next
Me.cmbdrives.AddItem fs.GetDrive(Chr(i) & ":")
Next i

Me.cmbfiletypes.AddItem "Text Files (*.txt)"
Me.cmbfiletypes.AddItem "All Files (*.*)"



Me.cmbfiletypes.ListIndex = 0

Me.cmbdrives.ListIndex = 0
nodename = Me.cmbdrives.Text
frmgetfiles.TV.Nodes.Clear
Set nodx = frmgetfiles.TV.Nodes.Add(, , nodename, nodename)
LogPath nodename

frmgetfiles.TV.Nodes.Item(nodename).Expanded = True
firstpass = 1


Exit Sub

End Sub


Private Sub lstfiles_Click()
Me.cmdsave.Enabled = True
End Sub

Private Sub TV_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo errorhandler


Screen.MousePointer = 11
nodename = Node.Key

DoEvents
frmgetfiles.Enabled = False
LogPath Node.Key
';arrayfilenames, arraypointers,
DoEvents

frmgetfiles.TV.Nodes.Item(Node.Key).Expanded = True
Screen.MousePointer = 0
frmgetfiles.Enabled = True
Exit Sub

errorhandler:
Screen.MousePointer = 0
frmgetfiles.Enabled = True

End Sub

Yorum Yapabilmek İçin Üye Girişi Yapmanız Gerekmektedir.

dosya ve klasörleri listeleme