Ich habe in einem VBA verschiedene SQL's und will nicht bei jeder Verbindung mit der AS400 meinen Benutzer und das Kennwort eingeben. Wie kann ich in VB das ganze prüfen und nur einmal eingeben. Ich habe eine Routine erstellt wenn aber das Kennwort falsch erfaßt wurde, muß dieses immer wieder neu bei jeder SQL-Verbindung eingegeben werden. Ich möchte Benutzer und Kennwort auf der AS400 prüfen und wenn diese falsch sind nur einen Fehlercode von der AS400 erhalten. Es soll dort nicht korrigiert werden dürfen.
Hier die Source
Private Sub cmdOK_Click()
Dim system As New cwbx.AS400System
system.Define "xxxxxxxx"
system.UserId = tbBenutzer
system.Password = tbKennwort
system.IPAddress = "nn.nn.nn.nn"
On Error GoTo weiter
system.Connect (cwbcoServiceODBC)
weiter:
If (system.IsConnected(cwbcoServiceODBC)) Then

Else
MsgBox "Fehler: Benutzername oder Kennwort falsch. Programmende"
Application.Quit
End If

Const CN_STR = "ODBC;Driver=iSeries Access ODBC Driver;SYSTEM=system.IPAddress ;DefaultLibrari;UID="
Dim sSQL1, sEOF1 As String
Dim cnADO1 As DAO.Connection
Dim rsDaten1 As DAO.Recordset
Dim wrkODBC1 As DAO.Workspace
Dim iPos2, iPos3 As Integer
Dim Firmen(99) As String
Dim Firmentext(99) As String

sSQL1 = "select fifirm, fiktad, fiortn" & _
" from cmdlib.ufirmp " & _
" order by fifirm, fiortn asc "

Set wrkODBC1 = DAO.CreateWorkspace("IBM/AS400", "", "", dbUseODBC)
Set cnADO1 = wrkODBC1.OpenConnection("", dbDriverCompleteRequired, False, CN_STR & system.UserId & "; Pwd =" & tbKennwort)
Set rsDaten1 = cnADO1.Database.OpenRecordset(sSQL1, dbOpenDynamic)

rsDaten1.MoveFirst
iPos3 = 0
sEOF1 = ""

While Not rsDaten1.EOF
FrmAuswahl.lbFirma.AddItem (rsDaten1.Fields("fifirm") & " " & rsDaten1.Fields("fiktad").Value)
Firmen(iPos3) = rsDaten1.Fields("fifirm").Value
Firmentext(iPos3) = (rsDaten1.Fields("fifirm") & " " & rsDaten1.Fields("fiktad").Value)
iPos3 = iPos3 + 1
rsDaten1.MoveNext
Wend
rsDaten1.Close

FrmAuswahl.Show
End Sub