Hej,

Sitter och jobbar med applikation som går ut på att samla data och trycka ner det i en SQL-databas.
Databasen befinner sig på en server en bit ifrån datorn där VBA-snutten rullar.

Nu är det så att jag är inne i slutskedet och håller på med felhanteringen.
Det har nu visat sig att felhanteringen av anslutningen mot databasen inte fungerar.

När man tex släcker ner switchar m.m mellan VBA-maskinen och SQL-databasen kommer inte anslutningen igång igen som den borde när man har rättat till felen.

Jag har försökt att hitta en lösning men det vill inte fungera.

Min lösning går ut på att när det kommer felkod som har med anslutningen att göra så kör jag ConFjarr.Close för att sedan efter ca 1 sekund kör jag ConFjarr.Open för att se om det går att koppla upp.

Till min förvåning så blir ConFjarr.State = 1 utan att nätverksladden sitter i eller switchar är igång.
Men det sker ingen fysisk uppkoppling och ConFjarr.State blir 1 direkt utan den sedvanliga fördröjningen.
Sedan kommer felkoderna igen då jag försöker skriva till databasen. Sen rullar det bara runt.
Sitter och funderar på om det går att lita på ConFjarr.State?

Här kommer koden:


Option Explicit
Private ConLokal As ADODB.Connection
Private ConFjarr As ADODB.Connection
Private SparaDbOkStn(6) As Boolean
Private SparaLokalOkStn(6) As Boolean
Private SparaFjarrOkStn(6) As Boolean
Public Information As String


Private Sub fvProject_StartupComplete()
Dim i As Integer

Set ConLokal = New ADODB.Connection
ConLokal.ConnectionString = "driver={SQL Server};server=" & Main.ThisSystem.ComputerName & ";database=dbLokal"
ConLokal.ConnectionTimeout = 3
ConLokal.CommandTimeout = 3

Set ConFjarr = New ADODB.Connection
ConFjarr.ConnectionString = "driver={SQL Server};server=172.19.4.29;database=dbFjarr"
ConFjarr.ConnectionTimeout = 3
ConFjarr.CommandTimeout = 3

For i = 1 To 6
Variables.Add "STN" & i & ".Db_modellnr", fvVariableTypeRegister
Variables.Add "STN" & i & ".Db_serienr_1", fvVariableTypeRegister
Variables.Add "STN" & i & ".Db_serienr_2", fvVariableTypeRegister
Variables.Add "STN" & i & ".Db_spara_till_databas", fvVariableTypeRegister
Next i

End Sub


Public Sub Kommunikation()
Dim OppnaLokalDbOk As Boolean
Dim OppnaFjarrDbOk As Boolean
Dim i As Integer

On Error GoTo ErrorHandler

If ConLokal.State = 0 Then ConLokal.Open
If ConLokal.State = 1 Then OppnaLokalDbOk = True

If ConFjarr.State = 0 Then ConFjarr.Open
If ConFjarr.State = 1 Then OppnaFjarrDbOk = True

For i = 1 To 6

If (Variables("STN" & i & ".Db_spara_till_databas") = 0) And SparaDbOkStn(i) = True Then
SparaDbOkStn(i) = False
End If

If (Variables("STN" & i & ".Db_spara_till_databas") = 1) And SparaDbOkStn(i) = False Then
Call Main.ThisProject.SparaDb(i)
End If

If (Variables("STN" & i & ".Db_spara_till_databas") = 1) And SparaDbOkStn(i) = True Then
Variables("STN" & i & ".Db_spara_till_databas") = 0
SparaDbOkStn(i) = False
End If

Next i

Exit Sub

ErrorHandler:

Select Case Err.Number

Case -2147467259

If OppnaLokalDbOk = False Then
Information = "Antingen finns inte Lokal SQL Server eller så nekas åtkomst!"
Debug.Print "Antingen finns inte Lokal SQL Server eller så nekas åtkomst!"
If ConLokal.State = 1 Then ConLokal.Close
Resume Next

End If

If OppnaFjarrDbOk = False Then
Information = "Antingen finns inte Fjärr SQL Server eller så nekas åtkomst!"
Debug.Print "Antingen finns inte Fjärr SQL Server eller så nekas åtkomst!"
If ConFjarr.State = 1 Then ConFjarr.Close
Resume Next
End If

Case Else

If OppnaLokalDbOk = False Then
Information = "Skrivning till Lokal Databas Misslyckades! " & "(" & Err.Number & ")"
Debug.Print "Skrivning till Lokal Databas Misslyckades!"
If ConLokal.State = 1 Then ConLokal.Close
Resume Next
End If

If OppnaFjarrDbOk = False Then
Information = "Skrivning till Fjarr Databas Misslyckades! " & "(" & Err.Number & ")"
Debug.Print "Skrivning till Fjarr Databas Misslyckades!"
If ConFjarr.State = 1 Then ConFjarr.Close
Resume Next
End If
End Select
End Sub


Public Sub SparaDb(StnNr As Integer)
Dim strSQLInsert As String
Dim strSQLCreate As String
Dim tblName As String
Dim Datum As String
Dim Tid As String
Dim Modellnr As String
Dim Serienr As String
Dim i As Integer
Dim x As String

On Error GoTo ErrorHandler

Datum = Date
Tid = Time
Modellnr = Right((1000000000 + Variables("STN" & StnNr & ".Db_modellnr")), 9)
Serienr = Right((1000000 + Variables("STN" & StnNr & ".Db_serienr_1")), 6) & Right((1000000 + Variables("STN" & StnNr & ".Db_serienr_2")), 6)

tblName = "tbl" & Left(Date, 4) & "STN" & StnNr

strSQLInsert = "INSERT INTO " & tblName & " (TS, Modellnr, Serienr) VALUES ('" & Datum & " " & Tid & "','" & Modellnr & "','" & Serienr & "')"

If SparaLokalOkStn(StnNr) = False And ConLokal.State = 1 Then
Debug.Print "ConLokal.Execute = INSERT INTO " & tblName & " " & Datum & " " & Tid
ConLokal.Execute strSQLInsert
SparaLokalOkStn(StnNr) = True
End If

If SparaFjarrOkStn(StnNr) = False And ConFjarr.State = 1 Then
Debug.Print "ConFjarr.Execute = INSERT INTO " & tblName & " " & Datum & " " & Tid
ConFjarr.Execute strSQLInsert
SparaFjarrOkStn(StnNr) = True
End If

If SparaLokalOkStn(StnNr) = True And SparaFjarrOkStn(StnNr) = True Then
Variables("STN" & StnNr & ".Db_spara_till_databas") = 0
SparaDbOkStn(StnNr) = True
SparaLokalOkStn(StnNr) = False
SparaFjarrOkStn(StnNr) = False
Information = ""
End If

Exit Sub

ErrorHandler:

Select Case Err.Number

Case -2147217865

strSQLCreate = "CREATE TABLE " & tblName & " (cID INT IDENTITY(1,1) NOT NULL, TS DateTime NOT NULL, Modellnr varchar(20) COLLATE Finnish_Swedish_CI_AS NOT NULL, Serienr varchar(20) COLLATE Finnish_Swedish_CI_AS NOT NULL)"

If SparaLokalOkStn(StnNr) = False Then
Debug.Print "ConFjarr.Execute = CREATE TABLE " & tblName
ConLokal.Execute strSQLCreate
Exit Sub
End If

If SparaFjarrOkStn(StnNr) = False Then
Debug.Print "ConFjarr.Execute = CREATE TABLE " & tblName
ConFjarr.Execute strSQLCreate
Exit Sub
End If

Case -2147467259

If SparaLokalOkStn(StnNr) = False Then
Information = "Antingen finns inte Lokal SQL Server eller så nekas åtkomst!"
Debug.Print "Antingen finns inte Lokal SQL Server eller så nekas åtkomst!"
If ConLokal.State = 1 Then ConLokal.Close
End If

If SparaFjarrOkStn(StnNr) = False Then
Information = "Antingen finns inte Fjärr SQL Server eller så nekas åtkomst!"
Debug.Print "Antingen finns inte Fjärr SQL Server eller så nekas åtkomst!"
If ConFjarr.State = 1 Then ConFjarr.Close
End If

Case Else

If SparaLokalOkStn(StnNr) = False Then
Information = "Skrivning till Lokal Databas Misslyckades! " & "(" & Err.Number & ")"
Debug.Print "Skrivning till Lokal Databas Misslyckades!"
If ConLokal.State = 1 Then ConLokal.Close
End If

If SparaFjarrOkStn(StnNr) = False Then
Information = "Skrivning till Fjarr Databas Misslyckades! " & "(" & Err.Number & ")"
Debug.Print "Skrivning till Fjarr Databas Misslyckades!"
If ConFjarr.State = 1 Then ConFjarr.Close
End If
End Select
End Sub

Har du provat OLEDB providern för SQL server? Ger den samma resultat?

Vad är OLEDB för något? En annan drivrutin?

Det finns minst två "drivrutiner" för SQL server. En ODBC drivrutin och en OLEDB provider.
Du använder ODBC drivrutinen. ADO använder OLEDB providers. Om du använder en ODBC drivrutin i ADO så kommer ett mellan lager, en ODBC till OLEDB provider att användas.

DB -> SQL ODBC drivrutin -> ODBC till OLEDB -> ADO -> VB

Detta kan vara orsaken till att tillståndet inte korrekt återspeglas. Men det är bara en chansning.

Om du använder SQL servers OLEDB proverer:

DB -> SQL OLEDB provider -> ADO -> VB

Här finner du exempel på anslutningssträngar:
http://www.carlprothman.net/Default.aspx?tabid=87#OLEDBProviderForSQLServer

Här finner du mer information om OLEDB:
http://en.wikipedia.org/wiki/OLEDB

Jag bugar och tackar för informationen.
Jag ska genast rätt till anslutningen för att se om det hjälper.

Fortsättning följer...

/Jörgen

Jag har nu provat med den nya "Drivrutinen" och den fungerar bättre och är något snabbare tycker jag.
Tackar än en gång för tipset.