Tomasz Kurnik Właściciel, TEKA
Temat: Logowanie do tabel sql serwer
Dzień dobrydotyczy: 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