title image


Smiley Re: Runtime, Verweise, Funktion
Nachtrag:



In dem Makro "Autoexec" habe ich AusführenCode CheckRefs() hinterlegt. Das sind folgende Prozeduren, die in einem Modul gespeichert sind:



Function CheckRefs()

Dim db As Database, rs As Recordset

Dim x

Set db = CurrentDb



On Error Resume Next



' Führt die Abfrage TestVerweise aus,um das Auftreten des Fehlers

' zu testen

Set rs = db.OpenRecordset("TestVerweise", dbOpenDynaset)

x = rs!ausdr1

' Wenn Sie nun den Fehler 3075 sehen, informieren Sie die

' Benutzer, daß Sie die Anwendung bearbeiten müssen.

' Fehler 3075 steht für folgende Meldung:

' "Funktion steht in Ausdrücken nicht zur Verfügung"



If Err.Number = 3075 Then

MsgBox "Diese Anwendung hat neuere Versionen " _

& "benötigter Dateien auf Ihrem Computer entdeckt. " _

& "Es kann einige Minuten dauern, Ihre Anwendung " _

& "erneut zu kompilieren."

Err.Clear

FixUpRefs

End If

End Function



Sub FixUpRefs()

Dim r As Reference, r1 As Reference

Dim s As String



' Sucht die erste Referenz in der Datenbank, die weder

' Access noch Visual Basic for Aplications ist.

For Each r In Application.References

If r.Name "Access" And r.Name "VBA" Then

Set r1 = r

Exit For

End If

Next

s = r1.FullPath



' Entfernt den Verweis und setzt ihn wieder ein.

References.Remove r1

References.AddFromFile s



' Ruft einen versteckten SysCmd-Befehl auf, um alle Moduleder

' Datenbank zu kompilieren bzw. zu speichern.

Call SysCmd(504, 16483)

End Sub



und eine Möglichkeit von Reinhard zum speichern von Verweisen:



Public Function VerweiseSichern(Optional Dateiname)

'--------------------------------------------------

Dim Ref As Reference, Tmp

If IsMissing(Dateiname) Then

Tmp = CurrentDb.Name

Dateiname = Mid(Tmp, 1, InStr(Tmp, Dir(Tmp)) - 1) & "Verweise_"

Tmp = Dir(CurrentDb.Name)

Dateiname = Dateiname & Mid(Tmp, 1, InStr(Tmp, ".") - 1) & ".txt"

End If

Open Dateiname For Output As #1

For Each Ref In Application.References

If Not Ref.IsBroken Then Print #1, Ref.Name; ";"; Ref.FullPath

Next Ref

Close

End Function



Public Function VerweiseRestaurieren(Optional Dateiname)

'-------------------------------------------------------

Dim Ref As Reference, Lin, RefN, RefF, Tmp

If IsMissing(Dateiname) Then

Tmp = CurrentDb.Name

Dateiname = Mid(Tmp, 1, InStr(Tmp, Dir(Tmp)) - 1) & "Verweise_"

Tmp = Dir(CurrentDb.Name)

Dateiname = Dateiname & Mid(Tmp, 1, InStr(Tmp, ".") - 1) & ".txt"

End If

Open Dateiname For Input As #1

Do While Not EOF(1)

Line Input #1, Lin

RefN = Mid(Lin, 1, InStr(Lin, ";") - 1)

RefF = Mid(Lin, InStr(Lin, ";") + 1)

On Error Resume Next

Set Ref = Application.References(RefN)

If Err 0 Then

On Error GoTo 0

'nicht vorhanden, erzeugen

Application.References.AddFromFile RefF

End If

Loop

Close

End Function



Mehr kann ich dir jetzt auch nicht mehr bieten...






Gruß

Wolli     danke für eure Fragen, so weiß ich, daß ich nichts weiß...

geschrieben von


Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: