# Dateisuche und weiteres...



## delPaz (6. August 2003)

Hallo!
Nur so zur Info, hab noch nie so richtig mit VB zutun gehabt.
Hab in Access 97 eine DB eines Friedhofes. Jedes Grab hat eine Reihennummer und eine Grabnummer. Nach diesen Nummern werden Bilder zu den Gräbern zugewiesen.

Das Problem jetzt, der Kunde kopiert sich nun irgendwo die Datenbank rein, sonmit stimmt der Pfad für die Bilder nicht mehr. Also will ich nach der Datenbank suchen und den Pfad in einer Tabelle abspeichern. Ich hab schon Ideen mit den Objekten FileSearch und etc., kann sie aber nicht gerade mit Erfolg umsetzen.

Also wer ne Idee hat, nur her damit.

MfG 


Hab dies mal programmiert. Ist nicht grad das Beste.
Private Sub Befehl0_Click()
Dim i As Integer

With Application.FileSearch
    .LookIn = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien"
    .FileName = "St-marx*"
    For i = 1 To .FoundFiles.Count
        MsgBox .FoundFiles(i)
    Next i
End With

End Sub

//Nur nimmt er mir das .FileName nicht aber = Laufzeitfehler5, Unzulässiger Prozedurablauf oder ungültiges Argument.


----------



## delPaz (6. August 2003)

Private Sub Befehl0_Click()

Dim i As Integer

With Application.FileSearch
    .LookIn = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien"
    .FileName = "hallo.txt"
    If .Execute > 0 Then
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "Nichts gefunden"
    End If

End With

End Sub

So funktionierts, Grund, FileName nimmt keine * oder ?, ka warum.
Nur noch ne frage, wie durchsuche ich alle laufwerke, was muss ich bei lookin - befehl reinschreiben, oder muss ich eine Funktion dafür schreiben??

MfG


----------



## NRFi (7. August 2003)

du kannst mit do while als schleife und dir die dateien/ordner auflisten.
genau wie weiß ich jetzt nicht aus dem kopf und wills nicht ausprobieren 
so als konzeptidee..

du lässt dir die dateien aus dem pfad des lookins auslesen, trennst die dateien nach punkten mit split und hast dann ein array, woraus du mit ubound ziemlich unkompliziert den dateinamen kriegst, und die setzt du dann bei filename ein.

noch fragen?


----------



## delPaz (8. August 2003)

ich hab immer viele fragen.
progressbar hat sich erledigt, anderen weg gefunden. verzeichnisse kopieren hat sich auch erledigt. nun kommt etwas anderes.  

zum kopieren der verzeichnisse muss ich ja den pfad angeben. dieser pfad führt auf eine cd-rom. hab mit dem code den laufwerksbuchstaben herausgelesen, den vom cdrom:

Private Sub Form_Load()
Dim CDPath As String
Dim fso As New Scripting.FileSystemObject
Dim drv As Drive
For Each drv In fso.Drives
     If drv.DriveType = CDRom Then
          CDPath = drv.Path
          Exit For
     End If
Next drv
Set drv = Nothing
Set fso = Nothing
Text4 = CDPath & "\"
End Sub

aber wenn jemand 2 cd laufwerke hat, woher weiß ich, ob der code das richtige genommen hat??  
muss ich noch was dazufügen??


----------



## NRFi (8. August 2003)

viele fragen heißt viel arbeit  

und diese frage ist nicht schlecht ;-)

wenn du 2 cds in zwei laufwerken hast, wird der über for each...
beide ausgeben.
also for each blabla
kopiervorgang (pfad zum laufwerk usw)
next

der geht einmal in die schleife, führt den vorgang durch, wenn der fertig ist, springt der in der schleife eins weiter und nimmt sich das andere laufwerk.
hab mir jetzt den code nicht genau angeguckt, aber das wird so funktionieren, wenn das, was du da hingekritzelt hast, die laufwerke ausgibt 

gruß, Ich


----------



## delPaz (8. August 2003)

Ja das soll er aber nicht, sonst kommt in einer Funktion ein Laufzeitfehler heraus, weil er den Ordner auf der falschen CD nicht findet.
Könnte ich mit fso.fileExist nach einer datei auf der cd suchen, die es 100% nur auf dieser cd gibt und so den richtigen laufwerksbuchstaben herausfinden??
in etwa so:
For Each drv In fso.Drives
     If drv.DriveType = CDRom Then
          CDPath = drv.Path
          If fso.FileExists(CDPath & "\hallo.txt") Then
            CDPath = drv.Path & "\"
            Exit For
          Else
            CDPath = ""
          End If
     End If

habs noch nicht ausprobiert aber sollte ja funktionieren oder?


----------



## NRFi (8. August 2003)

das wäre quick und dirty..
wieso findet der den falschen ordner?
kann der nicht einfach von anfang an mit der funktion dir oder so die dinger durchlaufen und dabei kopieren?


----------



## delPaz (8. August 2003)

ich meinte das so:
die datenbank ist nur auf einer cd. wenn jetzt ein benutzer 2 laufwerke hat, wird er die cd ja nur in eins von beiden geben. zum kopieren muss ich herausfinden in welches laufwerk er diese cd gegeben hat. wenn nun der code mir beide laufwerksbuchstaben ausgibt nutzt es mir nichts. er soll ja nur den richtigen ausgeben. wenn er jetzt nun aufs falsche laufwerk zugreift, und sich dort kein datenträger befindet, kann er nichts kopieren und schon hat man einen fehler oder?


----------



## NRFi (8. August 2003)

achso...
dann fang den fehler ab.
if err.num = 

Private Const CDERR_STRUCTSIZE = &H1
Private Const CDERR_REGISTERMSGFAIL = &HC
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_DIALOGFAILURE = &HFFFF


irgendson fehler, könnte sein, dass das sogar dir richtigen konstanten irgendwo da drin richtig sind, dann soll der das näxte machen, sonst das näxte.
also mit on error goto...

verschdesde?


----------



## delPaz (8. August 2003)

jo, thx, hätte auch selber draufkommen können.  
danke, jetzt ist es "sauber programmiert". obwohl ich mir damit mehr mühe mache. ;-)


----------



## NRFi (8. August 2003)

quick n' dirty ist aber halt nicht so toll, lieber alles versuchen, schön dynamisch zu machen, dann kann mans universieller einsetzen 

ansonsten, kein tee-ma


----------



## delPaz (8. August 2003)

ich werds wahrscheinlich nie wieder brauchen, den ich hasse programmieren, aber was man nicht alles für geld macht!!


----------



## NRFi (8. August 2003)

geld ist immer gut  

und programmieren auch  


*g*


----------



## delPaz (8. August 2003)

wollte es nicht, hab aber noch ne frage.

ich will eine msgbox die auftacht wenn ein prozess starten, der "kopiervorgang", und die msgbox soll dann veschwinden wenn der vorgang zu ende ist, also der befehl fertig ist. hat irgendwer ne idee?


----------



## Grimreaper (8. August 2003)

MsgBox ist ungeeignet, da sie modal angezeigt wird, d. h. dein Programm wird so lange angehalten, bis sie weg ist. Du müsstest einfache eine selbsterstellte Form anzeigen lassen, die ein Label mit "Kopiervorgang" besitzt und wieder entladen wird, sobald dein Code durchgelaufen ist. Ich weiß aber nicht, ob das mit Access so möglich ist.

mfg Grimreaper


----------



## delPaz (8. August 2003)

hmm, ich hoffe mal das in access sowas geht. sonst würde es ein bisschen problematisch sein, wenn du user nicht weiß was der pc gerade macht und den kopiervorgang mit alt+strg+entf beendet.

also wenn wer ne idee hat, nur her damit.


----------



## NRFi (8. August 2003)

du kannst doch auch in deiner hauptform, wenns eine gibt eine statusbar reinbauen und da halt als status kopiere...

ansonsten kannste das auch mit access.
dim bla as form
set bla = new form
bla.show


oder so ähnlich, ansonsten kannste die auch einfach so zu deinem projekt normalerweise hinzufügen


----------



## delPaz (11. August 2003)

so, hab da noch ne frage:
wie übergebe ich variablen einer form, an eine andere form??


----------



## Thomas Darimont (11. August 2003)

Servus!

DoCmd.OpenForm(Formularname, Ansicht, Filtername, Bedingung, Datenmodus, Fenstermodus, Öffnungsargumente)

Öffnungsargumente sind dein Freund ... in der anderen Form kannst du dann mit me.openargs darauf zugreifen ...

Gruß Tom


----------



## delPaz (11. August 2003)

also die variablen die ich übergeben will sind aPath und sPath (sind beide strings). sie sollen vom formular screen2 and screen3 übergeben werden.
ich deklariere die beiden als dim und weiße ihnen per textbox einen wert zu, in diesem fall 2 pfade.

dann kommt das oder?

DoCmd.OpenForm "Screen3", acForm, , , , , ?????????)
wie übergebe ich 2 variablen.
mit einer würde es ja so ausschauen

DoCmd.OpenForm "Screen3", acNormal, , , acReadOnly, , "aPath")

oder?


----------



## Thomas Darimont (11. August 2003)

Servus!

Also ich hab das bis jetzt immer so gemacht:

Ich will die beiden Strings a und b an das Fromular frmTest übergeben:

Docmd.openform frmTest,acForm,,,,,a & "#" & b

...

in der From frmTest habe ich die beiden Argumente wieder mit

dim args() as String

args = Split(me.openArgs,"#")

"umgewandelt" ...

Gruß Tom


----------



## delPaz (11. August 2003)

also, Formular Screen2:

.....
aPath = Text1
sPath = Text2

DoCmd.Close acForm, "Screen2", acSaveNo
DoCmd.OpenForm "Screen3", acForm, , , , , "aPath" & "#" & "sPath"


Screnn3:
....
Dim args() As String

args=Split(me.openargs,"#")
aPath1 = args(1)
sPath1 = args(2)

oder??

ich programmiere in access 97, glaub nicht das dieser die funktion split kennt.
funktioniert bei mir nicht ganz!!


----------



## Thomas Darimont (11. August 2003)

Servus!

Versuchs mal mit:

DoCmd.OpenForm "Screen3", acForm, , , , , aPath & "#" & sPath

...

Gruß Tom


----------



## delPaz (11. August 2003)

das problem scheint zu sein access 97 die sub SPLIT nicht kennt. gibts da ne andere methode den string zu teilen??


----------



## Thomas Darimont (11. August 2003)

Servus!

Normalerweise müßte Access 97 diese Split Funktion kennen ... 

aber hier mal quick & dirty eine eigne Version ...


```
Dim str As String
Dim escapeChar As String
Dim anzahlEscapeChar As Integer
Dim i As Integer
Dim j As Integer
Dim StringBuffer() As String


escapeChar = "#"
str = "hallo#test"

For i = 1 To Len(str)
    If Mid(str, i, 1) = escapeChar Then
        anzahlEscapeChar = anzahlEscapeChar + 1
    End If
Next i

ReDim StringBuffer(anzahlEscapeChar + 1)

j = 1

For i = 1 To Len(str)
    
    If Mid(str, i, 1) = escapeChar Then
        j = j + 1
        i = i + 1
    End If
    
    StringBuffer(j) = StringBuffer(j) + Mid(str, i, 1)
    
Next i
```

Hier noch eine alternative:

http://www.kraasch.de/vba003.htm

Gruß Tom


----------



## delPaz (11. August 2003)

habe das gefunden:



> Dim fso As New FileSystemObject
> Dim Folder As Folder
> Dim sPath1 As String
> Dim aPath1 As String
> ...



nur ich weiß nicht warum er mir bei inp_str = Me.OpenArgs einen Laufueitfehler ausgibt.


----------



## Thomas Darimont (11. August 2003)

Servus!

Schau doch einfach mal nach, ob in me.OpenArgs überhaupt was drin steht ...

msgbox "" & me.openargs ...

Gruß Tom


----------



## delPaz (11. August 2003)

nö es steht nichts drinnen, obwohl meiner meinung nach die übergabe funktionieren sollte.

Private Sub Befehl10_Click()
    Public sPath As String
    Public aPath As String

    sPath = Text2
    aPath = Text5

    DoCmd.Close acForm, "Screen2", acSaveNo
    DoCmd.OpenForm "Screen3", , , , , , aPath & "#" & sPath


End Sub

oder muss ich die sub auch als public definieren??


----------



## delPaz (11. August 2003)

hab den fehler gefunden. musste nur die variablen als dim und nicht als public definieren, keine ahung wieso.

danke für deine hilfe tom. bin jetzt ein ganzes stück weiter.

MfG


----------



## Thomas Darimont (11. August 2003)

Servus!

...uff das hab ich gar nicht gesehen ... ;-)

Mit dim deklarierst du eine Variable ... Public ist nur ein sogenannter Sichtbarkeitsmodifier ...

Gruß Tom


----------



## delPaz (11. August 2003)

habs vorher mit einer anderen mehtode versucht, das per funktion zu übergeben, da hab ich die variablen auf public gesetzt und dies nicht mehr zurückgesetzt. jedenfalls danke für deine hilfe.

MfG


----------



## delPaz (12. August 2003)

ok, mein allerletztes problem, versprechen kann ich es aber nicht.  

wie kann ich einen verweis auf eine objekt´-bibliothek programmieren sodass der user nicht selbst auf diese verweisen soll. ist die "Microsoft Scripting Runtime" für die FSO Methode. Ich weiß das sie in der scrrun.dll unter c:\win\system32 ist. Aber brauche ja nur den verweis, kann man so einen verweis programmieren??


----------



## Thomas Darimont (12. August 2003)

Servus!

Du meinst wojl: "Wie kann ich einen Verweis auf eine DLL unter Access per VBA setzen, so dass das nicht mehr vom Benutzer zu erledigen ist ..."


```
'-----------------------------------------------------------------------------------------------------
' Funktionen zum überprüfen und verändern der Verweise
' Version 1.00
' Bearbeitet am 22.11.1998
' Fehler, Wünsche, Verbesserungsvorschläge etc. bitte an:
' Ulrich Jenzer      e-mail: montag@pop.agri.ch
' (ADD und REMOVE Reference funktioniert in MDE leider nicht!)
' Ein ungültiger Verweis lässt sich nicht löschen.
'-----------------------------------------------------------------------------------------------------

Option Compare Database
Option Explicit

' Neue Instanz der Klasse VerwEreignisse erstellen.
Dim objVerwEreignisse As New clsVerwEreignisse

Public Function CheckAllReferences() As Boolean
   Dim B As Boolean
   B = B Or Not ReferenceCheckAndRepaire("VBA")
   B = B Or Not ReferenceCheckAndRepaire("Access")
   B = B Or Not ReferenceCheckAndRepaire("ComCtlLib", "C:\Windows\System\ComCtl32.ocx")
   'Hier sämtliche benötigten Verweise eintragen...
   CheckAllReferences = Not B
   MsgBox IIf(B, "Fehlerhafter Verweis", "Alle Verweise i.O."), vbInformation
End Function

Public Function ReferenceAddFromFile(sFile As String) As Boolean
   Dim ref As Reference
   
   On Error GoTo Error_ReferenceAddFromFile
   Set ref = objVerwEreignisse.evtVerweise.AddFromFile(sFile)
   ReferenceAddFromFile = True
   
Exit_ReferenceAddFromFile:
   Exit Function
   
Error_ReferenceAddFromFile:
   MsgBox "Error " & Err.Number & "@" & Err.Description & "@" & sFile, vbCritical
   ReferenceAddFromFile = False
   Resume Exit_ReferenceAddFromFile
   
End Function

Public Function ReferenceAddFromGuid(sGUID As String, lMajor As Long, lMinor As Long) As Boolean
   Dim ref As Reference
   
   On Error GoTo Error_ReferenceAddFromGuid
   Set ref = objVerwEreignisse.evtVerweise.AddFromGuid(sGUID, lMajor, lMinor)
   ReferenceAddFromGuid = True
   
Exit_ReferenceAddFromGuid:
   Exit Function
   
Error_ReferenceAddFromGuid:
   MsgBox "Error " & Err.Number & "@" & Err.Description & "@" & sGUID, vbCritical
   ReferenceAddFromGuid = False
   Resume Exit_ReferenceAddFromGuid
   
End Function

Public Function ReferenceCheckAndRepaire(sName As String, Optional sFile As Variant, Optional sGUID As Variant, Optional lMajor As Variant, Optional lMinor As Variant) As Boolean

   On Local Error GoTo Error_ReferenceCheckAndRepaire
   
   If ReferenceExist(sName) Then
      If ReferenceIsBroken(sName) Then
         Call ReferenceRemove(sName)
      End If
   End If
   
   If Not ReferenceExist(sName) Then
      If Not IsMissing(sFile) Then
         'Hier müsste man noch einen FileOpen Dialog einbauen,
         'für den Fall da die Datei nicht vorhanden ist.
         If Len(Dir(CStr(sFile))) > 0 Then
            Call ReferenceAddFromFile(CStr(sFile))
         End If
         
      ElseIf Not IsMissing(sGUID) And Not IsMissing(lMajor) And Not IsMissing(lMinor) Then
         Call ReferenceAddFromGuid(CStr(sGUID), CLng(lMajor), CLng(lMinor))
      End If
   End If
   
   ReferenceCheckAndRepaire = ReferenceExist(sName)
   
Exit_ReferenceCheckAndRepaire:
    Exit Function

Error_ReferenceCheckAndRepaire:
    MsgBox "Error " & Err.Number & "@" & Err.Description & "@", vbCritical
    ReferenceCheckAndRepaire = False
    Resume Exit_ReferenceCheckAndRepaire
    
End Function

Public Function ReferenceExist(sName As String) As Boolean
   On Error Resume Next
   Call References.item(sName)
   ReferenceExist = (Err = 0)
End Function

Public Function ReferenceInfo(sName As String) As Boolean
   Dim ref As Reference
   Dim sMsg As String
   
   On Error GoTo Error_ReferenceInfo
   Set ref = References.item(sName)
   sMsg = ref.Name & "@"
   sMsg = sMsg & ref.FullPath & vbCrLf & vbCrLf & ref.Guid
   sMsg = sMsg & "@Version " & ref.Major & "." & ref.Minor & vbCrLf & vbCrLf
   sMsg = sMsg & IIf(ref.BuiltIn, "[x]", "[  ]") & "  BuiltIn" & vbCrLf
   sMsg = sMsg & IIf(ref.IsBroken, "[x]", "[  ]") & "  IsBroken"
   MsgBox sMsg, IIf(ref.IsBroken, vbCritical, vbInformation), "Reference " & IIf(ref.IsBroken, "ERROR", "Info")
   ReferenceInfo = True
   
Exit_ReferenceInfo:
   Exit Function
   
Error_ReferenceInfo:
   If Err = 9 Then
      MsgBox sName & "@Missing Reference!@" & sName, vbCritical
   Else
      MsgBox "Error " & Err.Number & "@" & Err.Description & "@" & sName, vbCritical
   End If
   ReferenceInfo = False
   Resume Exit_ReferenceInfo

End Function

Public Function ReferenceIsBroken(sName As String) As Boolean
   On Error Resume Next
   ReferenceIsBroken = References.item(sName).IsBroken
End Function

Public Function ReferenceRemove(sName As String) As Boolean
    Dim ref As Reference
    
    On Error GoTo Error_ReferenceRemove
    Set ref = objVerwEreignisse.evtVerweise(sName)
    objVerwEreignisse.evtVerweise.Remove ref
'    Call References.Remove(References.item(sName))
    ReferenceRemove = True
   
Exit_ReferenceRemove:
    Exit Function
   
Error_ReferenceRemove:
    MsgBox "Error " & Err.Number & "@" & Err.Description & "@" & sName, vbCritical
    ReferenceRemove = False
    Resume Exit_ReferenceRemove
   
End Function

Public Function ShowAllReferences(Optional bNurFehlerhafte As Variant = False)
    Dim ref As Reference
    Dim sName As String
    
    On Error GoTo Error_ShowAllReferences
    For Each ref In References
        If Not IsError(ref.Name) Then
            sName = sName & "(" & ref.Name & " = OK)" & vbCrLf ' Dient zum feststellen ob irgend ein Verweis ungültig ist.
        End If
    Next
    For Each ref In References
        If Not bNurFehlerhafte Then
            Call ReferenceInfo(ref.Name)
        Else
            If Not ReferenceExist(ref.Name) Then
                Call ReferenceInfo(ref.Name)
            Else
                If ReferenceIsBroken(ref.Name) Then
                    Call ReferenceInfo(ref.Name)
                End If
            End If
        End If
    Next

Exit_ShowAllReferences:
    Exit Function

Error_ShowAllReferences:
    MsgBox "Error " & Err.Number & "@" & Err.Description & "@" & sName, vbCritical
    Resume Exit_ShowAllReferences

End Function
```

Gruß Tom


----------



## delPaz (12. August 2003)

danke,
werds mal versuchen. mal schaun obs dann funktioniert.


----------

