Funktionsaufruf
07.01.2005 11:19:28
H.Eberts
ich habe da ein Problem mit einem Funktionsaufruf. Die Funktion an sich funktioniert und liefert auch korrekte Ergebnisse. Allerdings wird sie von Excel ab und an(z.B. ich bin in einem Feld und habe es bearbeitet, nun wechsle ich in eine anderes Feld) einfach so aufgerufen, obwohl ich das gar nicht will. Wenn ich den Funktionsmanager benutze kann ich das erste Argument eingeben (ohne Fehlermeldung). Wenn ich nun das Datum eintragen möchte kommt direkt nach der Eingabe der ersten Ziffer eine von mir definierte Fehlermeldung (im Code mit ** gekennzeichnet).Jetzt weiß ich nicht, wie kommt Excel an diese Stelle? Ich bin doch noch gar nicht in der Funktion drin. Diese Fehlermeldung kommt nun nach jeder weiteren Zifferneingabe des Datums, allerdings immer mit anderen Werten. Ist die Eingabe beendet und mit ok bestätigt wird die Funktion korrekt ausgeführt. Wenn ich den Debugger benutze sehe ich allerdings, das die Funktion öfters als einmal aufgerufen wird. Warum?
Mein Problem ist nun, das ich die Funktion trotz Eingabe korrekter Werte nicht ohne Fehlermeldung benutzen kann. Weiß zufällig jemand warum dies so ist?
Code:
Function getKurs(psString As String, psDate As Date)
Dim lsSQL As String
Dim lcmd As ADODB.Command
Dim lrsanswer As ADODB.Recordset
Dim lsIDSecurity As String
On Error GoTo ErrorHandler
'Ist der User schon an der DB angemeldet?
'Wenn nicht wird der Anmeldedialog aufgerufen
If Not dbUser.LoggedIn Then
Call dbUser.LoginByUser("Excel", "", "")
End If
Set lcmd = New ADODB.Command 'Objekt erzeugen
Set lcmd.ActiveConnection = dbUser.Connection
lcmd.CommandTimeout = 100 'Timeout
lcmd.CommandType = adCmdText 'Commando ART
'Kontrolle des Übergabewertes und zusammensetzen des Select-Strings
If (Len(psString) = 12) Then
lsSQL = "Select ID from TEST where CODE1 = ?"
lcmd.CommandText = lsSQL 'Textzuweisung zum Objekt
Call lcmd.Parameters.Append(lcmd.CreateParameter("psString", adVariant, adParamInput, , psString))
ElseIf (Len(psString) = 6) Then
lsSQL = "Select ID from TBLTEST where CODE2 = ?"
lcmd.CommandText = lsSQL 'Textzuweisung zum Objekt
Call lcmd.Parameters.Append(lcmd.CreateParameter("psString", adVariant, adParamInput, , psString))
End If
Set lrsanswer = lcmd.Execute 'SQL Ausführen
If Not lrsanswer.EOF Then
lsID = lrsanswer!ID
lsSQL = "Select VALUE from VEWHIST where ID = ? and trunc(DATE) = ?"
lcmd.Parameters.Delete (0)
lcmd.CommandText = lsSQL 'Textzuweisung zum Objekt
Call lcmd.Parameters.Append(lcmd.CreateParameter("lsID", adVariant, adParamInput, , lsID))
Call lcmd.Parameters.Append(lcmd.CreateParameter("psDate", adDate, adParamInput, , psDate))
Set lrsanswer = lcmd.Execute 'SQL Ausführen
If Not lrsanswer.EOF Then
getKurs = lrsanswer!Value
Else
MsgBox "Es wurde kein Datensatz mit ID = " & lsID & " und Datum " & psDate & " gefunden"
End If
Else
MsgBox "Es wurde kein Datensatz mit Code = " & psCODE & " gefunden"
End If
' If Not lcmd Is Nothing Then Set lcmd = Nothing
' If Not lrsanswer Is Nothing Then
' If Not lrsanswer.State = adStateOpen Then lrsanswer.Close
' Set lrsanswer = Nothing
' End If
Exit Function
ErrorHandler:
MsgBox "Fehler: " & Err.Description
End Function