Dateisuche und weiteres...

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 :)
 
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??
 
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 ..."

Code: 
'-----------------------------------------------------------------------------------------------------
' 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
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück