Public Function fct_Anmelden(User As String, PW As String, Optional str_Server As String, Optional str_db As String)
Dim str_Connection As String
Dim str_internServer As String
Dim str_internDB As String
On Error GoTo HandleErr
str_internServer = IIf(IsNull(str_Server) Or str_Server = "", Standardserver, str_Server)
str_internDB = IIf(IsNull(str_db) Or str_db = "", Standarddatenbank, str_db)
'Standardserver and Standarddatenbank are global variables 'containig standard values for server and database
If User = "" Or PW = "" Then
str_Connection = ""
Else
str_Connection = "PROVIDER=SQLOLEDB.1;" & _
"PERSIST SECURITY INFO=FALSE;" & _
"INITIAL CATALOG=" & str_internDB & ";" & _
"DATA SOURCE=" & str_internServer
End If
'If you call these function with emty strings vor DB or PW
'the connection string will be "" and the Frontend is left
'disconectet. This is importent because the BaseConnectionstring
'is saved and will call the standard SQL-Login form when the
'Frontend is restarted. You should call the function in this
'way if you exit the frontend
CurrentProject.OpenConnection str_Connection, User, PW
If CurrentProject.IsConnected Then
Form_frm_Anmeldung.Detailbereich.BackColor = 65123
Form_frm_Anmeldung.cmd_Anmelden.Caption = "Abmelden"
DoCmd.Minimize
DoCmd.OpenForm "frmHaupt"
Else
Form_frm_Anmeldung.Detailbereich.BackColor = 255
Form_frm_Anmeldung.cmd_Anmelden.Caption = "Anmelden"
End If
ExitHere:
Exit Function
HandleErr:
Select Case Err.Number
Case -2147467259
MsgBox "Sie haben einen falschen Server- oder " & _
"Datenbanknamen eingegeben! ", vbCritical, _
"Falscher Server- oder Benutzername"
'False DB or Server
Case -2147217843
MsgBox "Benutzername oder Passwort falsch!", _
vbCritical, "Anmeldungsfehler"
Form_frm_Anmeldung.txt_Passwort.SetFocus
'False PW or Username
Case Else
MsgBox "---Fehler " & Err.Number & ": " & Err.Description, vbCritical, "mod_formModule.fct_Anmelden" 'ErrorHandler:$$N=mod_formModule.fct_Anmelden
End Select
' Ende des Fehlerbehandlungsblocks.
End Function