Hey Leute,
ich muss ein Programm von VB6 in VB.Net umschreiben und habe jetzt auch alles hinbekommen ausser die Sache mit Excel. Hier mal der alte Programm-Code
Option Explicit
Sub checkall()
Dim rslabalias As Recordset
Dim X As Field
Dim i As Integer
Dim such As String
Dim rstemp As Recordset
Call center(frmmain)
frmMsg.Label1 = "Tabellen werden geprüft...."
frmMsg.Label2 = ""
Call center(frmMsg)
frmMsg.Show 0
DoEvents
Set db = Workspaces(0).OpenDatabase(database, False, True, dbtype)
' Tabellen vorhanden??
If checktables(dbgroups) = False Then End
If checktables(dbclients) = False Then End
' Globale Recordsets erzeugen
Set rsclients = db.OpenRecordset(dbclients, dbOpenDynaset)
Set rsgroups = db.OpenRecordset(dbgroups, dbOpenDynaset)
' Alle Felder definiert?
If checkfield(dbclients, "Server") = False Then End
If checkfield(dbclients, "Client") = False Then End
If checkfield(dbclients, "Rules") = False Then End
If checkfield(dbclients, "Labels") = False Then End
If checkfield(dbclients, "JT") = False Then End
If checkfield(dbgroups, "Group") = False Then End
If checkfield(dbgroups, "NT-Group") = False Then End
' sind alle in der Tabelle "Kunden" in der Spalte "Rules"
' aufgeführten auch als Tabelle vorhanden?
rsclients.MoveFirst
Do While Not rsclients.EOF
If Len(rsclients.Fields("rules")) > 0 Then
If checktables(rsclients.Fields("rules")) = False Then End
' Checke alle "Rules" auf Syntax (alle Gruppen konsistent?)
Call checkrules(rsclients.Fields("rules"))
End If
rsclients.MoveNext
Loop
' sind alle in der Tabelle "Kunden" in der Spalte "Labels"
' angeführten Labels auch als Tabelle vorhanden?
rsclients.MoveFirst
Do While Not rsclients.EOF
If Len(rsclients.Fields("labels")) > 0 Then
If checktables(rsclients.Fields("labels")) = False Then End
' prüfen ob client auch in Labeltabelle eingetragen
Set rstemp = db.OpenRecordset(rsclients.Fields("labels") & "$", _
dbOpenDynaset)
such = "Client='" & rsclients.Fields("client") & "'"
rstemp.FindFirst such
If rstemp.NoMatch Then
' Wenn nicht gefunden
MsgBox "Für Client " & rsclients.Fields("client") & "" & _
"Labelverzeichnis angegeben, aber kein Eintrag in " & _
rsclients.Fields("labels")
End
End If
End If
rsclients.MoveNext
Loop
' sind bei allen in der Tabelle "Kunden" in der Spalte "Labels" definierten
' Tabellen die jeweils in der 2.zeile aufgeführten Labels auch vorhanden?
rsclients.MoveFirst
Do While Not rsclients.EOF
i = 0
If Len(rsclients.Fields("labels")) > 0 Then
Set rslabalias = db.OpenRecordset(rsclients.Fields("labels") & "$", _
dbOpenDynaset)
For Each X In db.TableDefs(rsclients.Fields("labels") & "$").Fields
If Left(X.Name, 1) = "L" Then
rslabalias.MoveFirst
rslabalias.MoveNext 'Positioniere auf zweite Zeile (
' label-file)
If Len(rslabalias.Fields(i)) > 0 Then
Call checktables(rslabalias.Fields(i))
Call checkrules(rslabalias.Fields(i))
End If
End If
i = i + 1
Next
End If
rsclients.MoveNext
Loop
' Lösche alle nicht mehr benötigten Objekte
Set rsclients = Nothing
Set rsgroups = Nothing
Set db = Nothing
frmMsg.Hide
End Sub |