disebabkan ramai yang bertanya pasal mcmmane nak link db ke vb... kat sini ada coding mcmmane nak link pakai adodb... pasal pakai adodc aku dah xigt
'letak kat satu module berasingan drpd coding.. cth modUmum ke modDatabase
'ke modKAripap pon boleh jugak ..
Option Explicit
Global gcnRpt As New ADODB.Connection
Global gcnRptString As String
Global gcnRead As New ADODB.Connection
Global gcnReadString As String
Global gcnUpdate As New ADODB.Connection
Global gcnUpdateString As String
'ubah kat sini aje..
Private Function fnGetConnectionString()
Dim strConnString As String
strConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\dbWJSH.mdb;Persist Security Info=False"
fnGetConnectionString = strConnString
End Function
Sub prOpenRecordSetRead(ByVal strSQL As String, RS As ADODB.Recordset)
On Error GoTo errHandler
If gcnRead Is Nothing Or gcnReadString = "" Then
If fnOpenConnRead() Is Nothing Then
MsgBox "Database cannot be accessed at this time." & vbCr & _
"Please try again later.", vbCritical
Set RS = Nothing
Exit Sub
End If
Else
If gcnRead.State = adStateClosed Then
If fnOpenConnRead() Is Nothing Then
MsgBox "Database cannot be accessed at this time." & vbCr & _
"Please try again later.", vbCritical
Set RS = Nothing
Exit Sub
End If
End If
End If
gcnRead.IsolationLevel = adXactBrowse 'adXactReadCommitted
gcnRead.CursorLocation = adUseServer
RS.Open strSQL, gcnRead, adOpenDynamic, adLockReadOnly
Exit Sub
errHandler:
MsgBox Err.Description
Err.Clear
Set RS = Nothing
Set gcnRead = Nothing
gcnReadString = ""
End Sub
Sub prOpenRecordSetUpdate(ByVal strSQL As String, RS As ADODB.Recordset)
On Error GoTo errHandler
If gcnUpdate Is Nothing Or gcnUpdateString = "" Then
If fnOpenConnUpdate() Is Nothing Then
MsgBox "Database cannot be accessed at this time." & vbCr & _
"Please try again later.", vbCritical
Set RS = Nothing
Exit Sub
End If
Else
If gcnUpdate.State = adStateClosed Then
If fnOpenConnUpdate() Is Nothing Then
MsgBox "Database cannot be accessed at this time." & vbCr & _
"Please try again later.", vbCritical
Set RS = Nothing
Exit Sub
End If
End If
End If
gcnUpdate.IsolationLevel = adXactReadCommitted 'adXactBrowse 'adXactReadCommitted
gcnUpdate.CursorLocation = adUseServer
RS.Open strSQL, gcnUpdate, adOpenDynamic, adLockOptimistic
Exit Sub
errHandler:
MsgBox Err.Description
Err.Clear
Set RS = Nothing
Set gcnUpdate = Nothing
gcnUpdateString = ""
End Sub
Sub prCloseDestroyRecordSet(RS As ADODB.Recordset)
On Error Resume Next
If RS.State <> 0 Then
RS.Close
DoEvents
End If
Set RS = Nothing
Err.Clear
End Sub
Function fnOpenConnRead() As ADODB.Connection
On Error GoTo HandleConnectionError
gcnReadString = ""
Set gcnRead = New ADODB.Connection
gcnRead.CursorLocation = adUseServer
gcnRead.ConnectionTimeout = 15
gcnRead.Mode = adModeRead
gcnReadString = fnGetConnectionString
gcnRead.Open gcnReadString
Set fnOpenConnRead = gcnRead
Exit Function
HandleConnectionError:
Set gcnRead = Nothing
gcnReadString = ""
MsgBox Err.Description
Err.Clear
End Function
Function fnOpenConnUpdate() As ADODB.Connection
On Error GoTo HandleConnectionError
gcnUpdateString = ""
Set gcnUpdate = New ADODB.Connection
gcnUpdate.CursorLocation = adUseServer
gcnUpdate.ConnectionTimeout = 15
gcnUpdate.Mode = adModeReadWrite
gcnUpdateString = fnGetConnectionString
gcnUpdate.Open gcnUpdateString
Set fnOpenConnUpdate = gcnUpdate
Exit Function
HandleConnectionError:
Set gcnUpdate = Nothing
gcnUpdateString = ""
MsgBox Err.Description
Err.Clear
End Function
Private Sub prCloseConnRead()
If Not gcnRead.State = adStateClosed Then
gcnRead.Close
gcnReadString = ""
Else
gcnReadString = ""
End If
Set gcnRead = Nothing
End Sub
Private Sub prCloseConnUpdate()
If Not gcnUpdate.State = adStateClosed Then
gcnUpdate.Close
gcnUpdateString = ""
Else
gcnUpdateString = ""
End If
Set gcnUpdate = Nothing
End Sub
Sub prCloseConnAll()
Call prCloseConnRead
Call prCloseConnUpdate
End Sub utk call procedure korang sume (yg xabis2 bertanye psl mcmmane nak link db) tau kan? kalau xtau, cakap laa... nanti aku post mcmmane nak call procedure2 kat atas nih utk save,delete etc.