Søgefunktion

anybody???

300 points nu!

500

Her er et lille program som finder alle mapper og filer, den kan du bygge om til at finde filer eller mapper med !!

Du skal bruge :

1 Dir lister
2 Listbox
1 Command knap



Sub gennemløb(mappe As String, antal As Long, antalFiles As Long, str As Long)
\'array til mapper
Dim mapper() As String
Dim MyName As String
Dim fso, f, f1, fc, s, fl
\'antal fundne mapper
Dim antalentries As Integer
Dim i As Long
  antalentries = 0
  \'åbner dir
  Set fso = CreateObject(\"Scripting.FileSystemObject\")
  Set f = fso.GetFolder(Replace(mappe & \"\\\", \"\\\\\", \"\\\"))
  Set fc = f.SubFolders
 

  \'kør medens der er filer eller mapper i mappen
  For Each f1 In fc
  \'fjerner mapperne . og.. (hvorfor ???) og buster pagefile i win2000 som giver fejl
    ReDim Preserve mapper(antalentries)
    antal = antal + 1
    \'lægger mappen i arrayet
    mapper(antalentries) = f1.Name
    antalentries = antalentries + 1
    \'lister mappen på listbox
    List1.AddItem mappe & \"\\\" & f1.Name
    str = str + f1.Size
   
    Set fl = f.Files
    For Each fl1 In fl
      List2.AddItem mappe & \"\\\" & fl1.Name
    antalFiles = antalFiles + 1
    Next
  Next
 
  \'hvis der er mapper i mappen tager vi en tur mere
  If antalentries > 0 Then
    For i = 0 To UBound(mapper)
      gennemløb mappe & \"\\\" & mapper(i), antal, antalFiles, str
    Next
  End If
 
 
End Sub
Private Sub Command1_Click()
\'renser listboxene ol labels
List1.Clear
List2.Clear
Label1.Caption = \"\"
Dim antal As Long
Dim antalFiles As Long
Dim mappe As String
Dim drev As String
Dim str As Long
Dim sizeDrev As Double
Dim totalDrev As Double
\'finder mappen fra Dirbox
mappe = Dir1.Path
antal = 0
antalFiles = 0
str = 0
sizeDrev = 0
totalDrev = 0
\'starter gennemløb
gennemløb mappe, antal, antalFiles, str


drev = Left(mappe, 1)
get_str drev, totalDrev, sizeDrev
\'skriver resultatet
Label1.Caption = \"Drevet \" & drev & \" total = \" & FormatNumber(totalDrev, 0, -2) & \" Kbytes\" & \" ledig \" & FormatNumber(sizeDrev, 0, -2) & \" Kbytes\"
Label1.Caption = Label1.Caption & vbCrLf & \"Mappen \" & mappe & \" indeholder : \" & vbCrLf & antal & \" mappe/r samlet størrelse \" & FormatNumber((str / 1024), 0, -2) & \" byts\" & vbCrLf & antalFiles & \" fil/er\"
 
End Sub


Private Sub Form_Load()
\'sætter c:\\ til default dir
Dir1.Path = \"c:\\Corel\"
End Sub

Private Sub List1_DblClick()
\'sletter index på list2
List2.ListIndex = -1
\'åbner mappen
gotoFil
End Sub

Private Sub List2_DblClick()
\'sletter index på list1
List1.ListIndex = -1
\'åbner filen
gotoFil
End Sub

Sub get_str(strDrev As String, totalDrev As Double, sizeDrev As Double)
Dim fs, d, s
    Set fs = CreateObject(\"Scripting.FileSystemObject\")
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(strDrev)))
    totalDrev = FormatNumber(d.TotalSize / 1024, 0)
    sizeDrev = FormatNumber(d.AvailableSpace / 1024, 0)
End Sub

Den søger, den finder, og det er fedt!
MEN når jeg dobbeltklikker på den fil jeg vil åbne, kommer den med den her fejl:

Compile error:

Sub or Function not defined.



Så markere den det her med gult:

Private Sub List1_DblClick()

og
gotoFil

Med blåt








Hvad gør jeg så?

Prøv med:

Private Sub List1_DblClick()
\'sletter index på list2
List2.ListIndex = -1
\'åbner filen
Call Shell(List1)
End Sub

Private Sub List2_DblClick()
\'sletter index på list1
List1.ListIndex = -1
\'åbner filen
Call Shell(List2)
End Sub

Run time error kommer der bare :-(

Tilføj denne modul i projektet som modvbworld



Option Explicit

Public Declare Function ShellExecute 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
\'åbner i normal størrelse og sætter focus
Public Const SW_SHOWNORMAL = 1


Public Sub gotoFil()
\'finder mappen eller filen
Dim fil
If Filesys.List1.ListIndex >= 0 Then
fil = Filesys.List1.Text & \"\\\"
ElseIf Filesys.List2.ListIndex >= 0 Then
fil = Filesys.List2.Text
Else
  fil = \"c:\\\"
End If

fil = Replace(fil, \"\\\\\", \"\\\")

Dim Success As Long
\'åbner program som er default for filtype, hvis mappe stifinder
Success = ShellExecute(0&, vbNullString, fil, vbNullString, fil, SW_SHOWNORMAL)

End Sub

Jeg har tilføjet det, men det vil den slet ikke den hævder stadig der er fejl!!!

Har du rettet List 1 og 2 dobbeltclick tilbage ??

Ja!
Jeg har fået den til at søge som den skal, jeg kan bare ikke klikke på den fil/mappe jeg vil åbne!
Nu har jeg kopieret de sidste linjer du skrev ind, og smidt dem ØVERST i mit kodevindue!
Men det vil den slet ikke!

Snup den på http://hyde.dk/Eksperten/soeg_vb.zip

hyde

Den hævder der STADIG er en compile error............ selvom jeg bruger din.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Hvilken version af vb bruger du ??

6.0

Følgende er tilføjet under References :
Visual Basic for applications
Visual Basic runtime objects and procedures
Visual Basic objects and procedures
OLE automation

Hvis du åbner project1 i zip filen du har hentet hvor kommer fejlen ??

Jeg bruger VB 6.0 sp 4

hyde

hyde