Kako u VB mogu npr. na cijelom C disku tražiti foldere sa nekim specifičnim imenom npr. Video .našao sam u API-u funkcije FindFirstFile i FindNextFile ali mi baš ne odgovaraju.
Traženje Specifični Foldera pomoću Njihovih imena
Zaključano
Zakačeno
Evo ja sam ovaj kod koristio da ispunim TreeView kontrolu sa svi folderima na nekoj particiji. Ti ga samo malo prepravi da odgovara tvojim potrebama...
Ako bas nemozes sam mogu ja da ti je malo sredim...
Code:
Public Sub generateTree(tvw As TreeView, rootFolder As String)
On Error Resume Next
Dim rootDir As Folder
Dim nodX As Node
'first to see if given path is true
If FSO.FolderExists(rootFolder) = False Then Exit Sub
Set rootDir = FSO.GetFolder(rootFolder) 'then get that folder
'add it s root
Set nodX = tvw.Nodes.Add(, , rootDir.Path, rootDir.Path, "FOLDER")
nodX.Expanded = True
For Each oDir In rootDir.SubFolders 'for each subfolder in folder
'call addDir sub...
addDir CStr(oDir), tvw
Next oDir
End Sub
'this sub isn't mine (i found it somewhere on net, but i forgoted where), i just
'made some changes. it takes given folder name and add it (folder) and all his
'SubFolders in tree view
Private Sub addDir(dirname As String, tvw As TreeView)
Dim rootFolder As Folder, currentFolder As Folder, subFolder As Folder
Dim parentName As String
Dim nodX As Node
Set rootFolder = FSO.GetFolder(dirname) 'first get folder
If Not rootFolder.IsRootFolder Then 'check to see if folder isn't root
parentName = rootFolder.ParentFolder
Set nodX = tvw.Nodes.Add(parentName, tvwChild, rootFolder, rootFolder.Name, "FOLDER")
End If
'here gets all subfolders in given folder
For Each currentFolder In rootFolder.SubFolders
'and add it to tree
Set nodX = tvw.Nodes.Add(CStr(rootFolder), tvwChild, currentFolder, currentFolder.Name, "FOLDER")
For Each subFolder In currentFolder.SubFolders 'for each subfolder in subfolder
'everything goes again...
addDir subFolder.Path, tvw
Next subFolder
Next currentFolder
End Sub
Public Sub generateTree(tvw As TreeView, rootFolder As String)
On Error Resume Next
Dim rootDir As Folder
Dim nodX As Node
'first to see if given path is true
If FSO.FolderExists(rootFolder) = False Then Exit Sub
Set rootDir = FSO.GetFolder(rootFolder) 'then get that folder
'add it s root
Set nodX = tvw.Nodes.Add(, , rootDir.Path, rootDir.Path, "FOLDER")
nodX.Expanded = True
For Each oDir In rootDir.SubFolders 'for each subfolder in folder
'call addDir sub...
addDir CStr(oDir), tvw
Next oDir
End Sub
'this sub isn't mine (i found it somewhere on net, but i forgoted where), i just
'made some changes. it takes given folder name and add it (folder) and all his
'SubFolders in tree view
Private Sub addDir(dirname As String, tvw As TreeView)
Dim rootFolder As Folder, currentFolder As Folder, subFolder As Folder
Dim parentName As String
Dim nodX As Node
Set rootFolder = FSO.GetFolder(dirname) 'first get folder
If Not rootFolder.IsRootFolder Then 'check to see if folder isn't root
parentName = rootFolder.ParentFolder
Set nodX = tvw.Nodes.Add(parentName, tvwChild, rootFolder, rootFolder.Name, "FOLDER")
End If
'here gets all subfolders in given folder
For Each currentFolder In rootFolder.SubFolders
'and add it to tree
Set nodX = tvw.Nodes.Add(CStr(rootFolder), tvwChild, currentFolder, currentFolder.Name, "FOLDER")
For Each subFolder In currentFolder.SubFolders 'for each subfolder in subfolder
'everything goes again...
addDir subFolder.Path, tvw
Next subFolder
Next currentFolder
End Sub
Ako bas nemozes sam mogu ja da ti je malo sredim...
Hvala
Da li ti treba samo za foldere u root-u ili i za podfoldere?
Inace, ovaj mi kod izgleda priilicno neoptimizovan...
Inace, ovaj mi kod izgleda priilicno neoptimizovan...
Treba mi za obadvoje....
@VRKY. Onda ti preporucujem da koristis rekurzivnu funkciju (koja moze biti jednostavnija od onih koje ti je dao krckoorascic). I koja je, BTW, verovatno na nekom od ona dva linka gore (nisam otvarao linkove):).
Hvala. Sad ću ić malo to pogledat.
Kolko sam vidio 2. link je za VB NET. Prvi je prilično dobar. Ja sam negdje naletio na ovaj primjer ali ne radi baš nešto OK.
Code:
Private Sub Form_Load()
FindStuff "C:\"
End Sub
Function FindStuff(sBegin As String)
Dim Search As Object, Fold
Set Search = CreateObject("Scripting.FileSystemObjects")
For Each Fold In Search.GetFolder(sBegin).SubFolders
If InStr(LCase(Fold), "ES") Then
MsgBox "Imaa"
End If
Call FindStuff(Fold.Path)
Next Fold
End Function
Private Sub Form_Load()
FindStuff "C:\"
End Sub
Function FindStuff(sBegin As String)
Dim Search As Object, Fold
Set Search = CreateObject("Scripting.FileSystemObjects")
For Each Fold In Search.GetFolder(sBegin).SubFolders
If InStr(LCase(Fold), "ES") Then
MsgBox "Imaa"
End If
Call FindStuff(Fold.Path)
Next Fold
End Function
Na to sam mislio al' me mrzelo da pisem :) pa sam ti samo dao hint za rekurzivnu funkciju.
Treba
(obrati na paznju kako koristis UCase/LCase funkcije)
Code:
If InStr(UCase(Fold), "ES") Then
If InStr(UCase(Fold), "ES") Then
(obrati na paznju kako koristis UCase/LCase funkcije)
Gledasam malo po kodu... (ovom koji sam ja gore postovao) ali ne mogu naći grešku... zbog koje ne radi...
Greška je slijedeća:
A kad odem na DEBUG pokaže da je ovdje greška:
A kad odem na DEBUG pokaže da je ovdje greška:
Code:
Set Search = CreateObject("Scripting.FileSystemObjects")
Set Search = CreateObject("Scripting.FileSystemObjects")
Prblem je u Set Search = CreateObject("Scripting.FileSystemObjects"). Ne treba ti "s". Da bi izbegavao pojavljivanje ovakvih situacija obicno je bolje koristiti Early Binding. Bice ti lakse pri pisanju programa.
Hvala,sad donekle radi. Malo ću još optimizirati kod pa se nadam da će bit bolje.
Upravo sam išao još dodat u kod kod za kopiranje fajlova i to fino napravim i pokrenem, i nastane greška. A riječ je o: Fajl bi se trebao samo iskopirati u foldere pod imenom ES a kopije nastale po cijelom C disku... Zna li ko u čemu je greška?
Ja sam tražio grešku ali bez uspjeha...
Code:
Private Sub Form_Load()
FindStuff "C:\"
End Sub
Function FindStuff(sBegin As String)
Dim Search As Object, Fold
Set Search = CreateObject("Scripting.FileSystemObject")
For Each Fold In Search.GetFolder(sBegin).SubFolders
If InStr(UCase(Fold), "ES") Then
FileCopy App.Path & "\" & App.EXEName & ".exe", Fold.Path & "Vrky.exe"
End If
Call FindStuff(Fold.Path)
Next Fold
End Function
Private Sub Form_Load()
FindStuff "C:\"
End Sub
Function FindStuff(sBegin As String)
Dim Search As Object, Fold
Set Search = CreateObject("Scripting.FileSystemObject")
For Each Fold In Search.GetFolder(sBegin).SubFolders
If InStr(UCase(Fold), "ES") Then
FileCopy App.Path & "\" & App.EXEName & ".exe", Fold.Path & "Vrky.exe"
End If
Call FindStuff(Fold.Path)
Next Fold
End Function
Ja sam tražio grešku ali bez uspjeha...
Da ti ne bih bio debuger a i da malo mucnes glavom reci cu ti gde je greska al' ne i u cemu ;). Ako ne pronadjes kasnije cu ti reci. Evo linije gde se greska nalazi:
Code:
FileCopy App.Path & "\" & App.EXEName & ".exe", Fold.Path & "Vrky.exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", Fold.Path & "Vrky.exe"
Vjerovatno je onda greška tu:
Code:
Fold.Path & "Vrky.exe"
Fold.Path & "Vrky.exe"
Ja mislim da je grešak u onome što sam naveo ali kako grešku ispravit (ako je to greška)?
Code:
Fold.Path & "\" & "Vrky.exe"
Fold.Path & "\" & "Vrky.exe"