PHP Kod: Kodu kopyalamak için üzerine çift tıklayın!
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
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 (*.*)"