Tomasz Kurnik

Tomasz Kurnik Właściciel, TEKA

Temat: Logowanie do tabel sql serwer

Dzień dobry

dotyczy: Access2000

Do łączenia się z tabelami sql server wykorzystuję kod Mariusza Sankowskiego, link:
https://www.access.vis.pl/war322.htm

Wszystko pięknie działa, mam tabele, widzę dane ale nie mogę ich modyfikować ani dodawać nowych rekordów. W bazie sql mam najwyższe uprawnienia.
Poniżej wklejam kod, może ktoś coś zauważy:

Option Compare Database
Option Explicit

Dim strDatabase$, strServer$
Dim strUserId$, strPassword$

Sub btnCancel_Click()

On Error Resume Next
Access.CurrentProject.OpenConnection ""
Access.DoCmd.Quit acQuitSaveNone

End Sub

Private Sub btnLoguj_Click()
Dim con As ADODB.Connection
Dim strConnect$, strUser$
Dim Response As Integer

On Error GoTo Err_btnLoguj_Click

Access.DoCmd.Hourglass True
strDatabase = "integra"
strServer = "192.168.5.33"
strUserId = "admin"
strPassword = "@MJp$73wz@SXZ/]yh+QC@&AU6Dq&"

'powyższe dane przkładowe

strConnect = _
"Provider=SQLOLEDB.1" & _
";Persist Security Info=True"
'";Persist Security Info=False"

If Access.CurrentProject.Properties("TrustedConnection") Then
strConnect = strConnect & _
";Integrated Security=SSPI"
Else
strConnect = strConnect & _
";User ID=" & strUserId & _
";Password=" & strPassword
End If

strConnect = strConnect & _
";Initial Catalog=" & strDatabase & _
";Data Source=" & strServer & _
";Network Library=dbmssocn"

Set con = New ADODB.Connection
With con
.ConnectionString = strConnect
.ConnectionTimeout = 10
.Open
End With

Access.CurrentProject.OpenConnection strConnect
With Access.CurrentProject.Properties
.Add "DatabaseName", strDatabase
.Add "ServerName", strServer
.Add "UserId", strUserId
End With

VBA.MsgBox "Logowanie zakończone pomyślnie." & vbNewLine & vbNewLine & _
"Connection:" & vbNewLine & _
Access.CurrentProject.Connection & vbNewLine & vbNewLine & _
"BaseConnectionString:" & vbNewLine & _
Access.CurrentProject.BaseConnectionString, vbInformation

Access.DoCmd.Close

Exit_btnLoguj_Click:
Access.DoCmd.Hourglass False
On Error Resume Next
con.Close
Set con = Nothing
Exit Sub
Err_btnLoguj_Click:
VBA.MsgBox "Error " & VBA.Err.Number & ": " & VBA.Err.Description, vbExclamation
Resume Exit_btnLoguj_Click
End Sub

Private Sub chkTrusted_AfterUpdate()

On Error GoTo Err_chkTrusted_AfterUpdate

Me.txtUserId.Enabled = Not Me.chkTrusted
Me.txtPassword.Enabled = Not Me.chkTrusted
Access.CurrentProject.Properties.Add _
"TrustedConnection", Me.chkTrusted

Exit_chkTrusted_AfterUpdate:
Exit Sub
Err_chkTrusted_AfterUpdate:
VBA.MsgBox "Error " & VBA.Err.Number & ": " & VBA.Err.Description, vbExclamation
Resume Exit_chkTrusted_AfterUpdate
End Sub

Private Sub Form_Close()
On Error GoTo Err_Form_Close

If Access.CurrentProject.IsConnected = False Then btnCancel_Click

Exit_Form_Close:
Exit Sub
Err_Form_Close:
VBA.MsgBox "Error " & VBA.Err.Number & ": " & VBA.Err.Description, vbExclamation
Resume Exit_Form_Close
End Sub

Sub Form_Open(Cancel As Integer)
'---------------------------------------------------------------------------------
'Read connection properties if they exist
'---------------------------------------------------------------------------------
Dim prp As Access.AccessObjectProperty

On Error GoTo Err_Form_Open

For Each prp In Access.CurrentProject.Properties

Select Case prp.Name

Case "DatabaseName": Me.txtDatabase.Value = prp.Value

Case "ServerName": Me.txtServerName.Value = prp.Value

Case "TrustedConnection"
Me.chkTrusted = prp.Value
Me.txtUserId.Enabled = Not Me.chkTrusted
Me.txtPassword.Enabled = Not Me.chkTrusted

Case "UserId": Me.txtUserId.Value = prp.Value

End Select

Next prp

Exit_Form_Open:
Exit Sub
Err_Form_Open:
VBA.MsgBox "Error " & VBA.Err & ": " & VBA.Err.Description, vbExclamation
Resume Exit_Form_Open
End Sub