AW: ODBC Fehler abfangen
04.12.2003 16:01:52
Sebastian Jürges
So, umständlich wenns (wahrscheinlich) auch einfacher geht ... LÖSUNG:
========================================================================
Public
Sub zugriffs_test(dsn, uid, pwd) ' Über geben der nutzerdaten / server
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
'Überprüfungsdatei löschen (wenn existent)
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.fileexists("C:\db2xls.txt") Then
fs.deletefile ("C:\db2xls.txt")
End If
' Eine Shell öffnen, einen connect mit den angegeben daten ausführen und die darauf folgende ausgabe in datei C:\db2xls.txt ausgeben
Dim command, shellzugriff As String
command = "db2cmd " + Chr$(34) + "TITLE = ### Überprüfen der DB2-Anbindung ### & db2 connect to " + dsn + " USER " + uid + " using " + pwd + " > C:\db2xls.txt & exit" + Chr$(34) + " & exit"
shellzugriff = Shell(command, 0)
'Warten bis die datei erstellt ist (Shell abgeschlossen)
Do While Not fs.fileexists("C:\db2xls.txt")
Loop
'Warten bis die datei nicht mehr leer ist (sonst problem mit text-stream)
Do
Loop Until FileLen("C:\db2xls.txt") > 0
'Datei einlesen
Dim ds, d
Set ds = CreateObject("Scripting.FileSystemObject")
Set d = ds.OpenTextFile("c:\db2xls.txt", ForReading, TristateFalse)
s = d.ReadAll
d.Close
'eingelesene datei in E18 ausgeben, E19 ist formel LINKS(E18,9) um nur den SQLCode zu kriegen
Range("E18") = s
'Wenn E19 SQL Fehlercode (PASSWORD INVALID) dann Msgbox mit fehlerdatei und workbook zu
If Range("E19") = "SQL30082N" Then
MsgBox (s)
MsgBox ("Die Anwendung wird geschlossen")
ActiveWorkbook.Close
End If
End Sub
========================================================================