Minh Tiên > 15-12-16, 09:47 AM
Public mConn As ADODB.Connection
Public Sub OpenConnect(strDBPath As String,strDBPass As String)
Set mConn = New ADODB.Connection
With mConn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Data Source").Value = strDBPath
.Properties("Jet OLEDB:Database Password").Value = strDBPass
.CursorLocation = adUseClient
.Open
End With
End SubPublic Sub CloseConnect()
mConn.Close
Set mConn = Nothing
End SubFunction GetRecordCombo(mform As Form, strMa As String)
Dim sql As String, rs As New ADODB.Recordset
Select Case strMa
Case "cboMahang"
sql = "SELECT Mahang,Tenhang,Donvitinh as DVT,Nhomhang,Nganhhang,Gianhap,Giabanle as Dongia," & _
"Soluongton as SLton,Tylechietkhau as TyleCK FROM tblDanhsach_Hanghoa ORDER BY Mahang"
End Select
Set rs = GetRecordset(sql)
Set mform.Controls(strMa).Recordset = rs
Set rs = Nothing
End FunctionFunction GetRecordset(sql As String) As ADODB.Recordset
Dim mRst As ADODB.Recordset
Call OpenConnect(strDBPath, strDBPass)
Set mRst = New ADODB.Recordset
With mRst
.ActiveConnection = mConn
.Source = sql
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open
.ActiveConnection = Nothing
End With
Set GetRecordset = mRst
Set mRst = Nothing
Call CloseConnect
Exit Function
End FunctionFunction UpdateDSHH(mform As Form)
Dim sql As String
sql = "UPDATE tblDanhsach_Hanghoa AS d INNER JOIN (SELECT b.Mahang, [a].[Soluongton]-[b].[Soluongxuat] AS slTon" & _
" FROM tblXuathang_Banle_Chitiet AS b INNER JOIN tblDanhsach_Hanghoa AS a ON b.Mahang = a.Mahang" & _
" WHERE Sophieu=" & mform.txtSophieu & ") AS c ON d.Mahang = c.Mahang SET d.Soluongton = [c].[slTon];"
Call OpenConnect(strDBPath, strDBPass)
mConn.Execute sql
Call CloseConnect
End Functionhieuvn > 15-12-16, 11:18 AM
Minh Tiên > 15-12-16, 06:32 PM
maidinhdan > 15-12-16, 07:41 PM
hieuvn > 15-12-16, 09:30 PM
(15-12-16, 06:32 PM)Minh Tiên Đã viết: Code Update này mình làm theo hướng dẫn của pausteigel chạy OK bạn hieuvn ơi !
Mình chạy 1 PC kết nối dữ liệu thì OK ko vấn đề gì cả, chỉ xung đột khi cùng chạy 2 PC.
Thân./.
Function Connect() As Boolean
Set Cnn = New ADODB.connection
On Error Resume Next
With Cnn
' Create connecting string
.ConnectionString = strketnoimoi tao
' Open connection
.Open
End With
' Check connection state
If Cnn.State = 0 Then
Connect = False
Else
Connect = True
End If
End FunctionFunction GetRecordset(strSQL As String, Optional CursorLocation As ADODB.CursorLocationEnum = adUseClient, Optional CursorType As ADODB.CursorTypeEnum = adOpenForwardOnly, Optional LockType As ADODB.LockTypeEnum = adLockReadOnly) As ADODB.Recordset
Set Cnn = New ADODB.connection
If Connect Then
Set RS = New ADODB.Recordset
With RS
.CursorLocation = CursorLocation
.CursorType = CursorType
.LockType = LockType
.Open strSQL, Cnn
End With
Set GetRecordset = RS
End If
End Functionhoanbhxhls > 16-12-16, 08:58 AM
(15-12-16, 09:30 PM)hieuvn Đã viết:để giải quyết đụng độ khi viết bằng ms access trong mạng LAN(15-12-16, 06:32 PM)Minh Tiên Đã viết: Code Update này mình làm theo hướng dẫn của pausteigel chạy OK bạn hieuvn ơi !
Mình chạy 1 PC kết nối dữ liệu thì OK ko vấn đề gì cả, chỉ xung đột khi cùng chạy 2 PC.
Thân./.
sorry bạn mình đọc không kĩ cái querry, lúc đầu đọc không thấy chữ set!
xem lại thì mình thấy code kết nối hơi rối rắm nên code lại:
tạo 1 connectionstring từ trang https://www.connectionstrings.com/access/
tạo function ket noi:
Private Cnn As ADODB.connection
Mã:Function Connect() As Boolean
Set Cnn = New ADODB.connection
On Error Resume Next
With Cnn
' Create connecting string
.ConnectionString = strketnoimoi tao
' Open connection
.Open
End With
' Check connection state
If Cnn.State = 0 Then
Connect = False
Else
Connect = True
End If
End Function
sau đó mình mạn phép sửa lại function GetRecordset của bạn lại như sau:
Mã:Function GetRecordset(strSQL As String, Optional CursorLocation As ADODB.CursorLocationEnum = adUseClient, Optional CursorType As ADODB.CursorTypeEnum = adOpenForwardOnly, Optional LockType As ADODB.LockTypeEnum = adLockReadOnly) As ADODB.Recordset
Set Cnn = New ADODB.connection
If Connect Then
Set RS = New ADODB.Recordset
With RS
.CursorLocation = CursorLocation
.CursorType = CursorType
.LockType = LockType
.Open strSQL, Cnn
End With
Set GetRecordset = RS
End If
End Function
have fun
Minh Tiên > 16-12-16, 12:06 PM
Minh Tiên > 16-12-16, 12:13 PM
maidinhdan > 16-12-16, 11:23 PM
ChuoiKetnoi = "Provider = SQLOLEDB;Data Source=222.254.241.8,1433;Initial Catalog=Vanbandientu;User ID=sa;Password=beyeu;"
linkData = "D:\VBDT2.0\Danh_muc_ho_so\data"
ChuoiKetnoi = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & linkData & "\DataTaikhoan.mdb;Jet OLEDB:Database Password=123;"
Private Sub Class_Initialize()
Dim cn As adodb.Connection
Set cn = New adodb.Connection
If cn.State = 0 Then Set cn = Nothing: Exit Function
Dim rs As adodb.Recordset
Set rs = New adodb.Recordset
Dim linkData As String
linkData = "D:\VBDT2.0\Danh_muc_ho_so\data"
Dim ChuoiKetnoi As String
ChuoiKetnoi = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & linkData & "\DataTaikhoan.mdb;Jet OLEDB:Database Password=123;"
Dim Sql As String
Sql = "SELECT * FROM tblTaikhoan"
cn.Open ChuoiKetnoi
rs.Open Sql, cn, adOpenDynamic, adLockReadOnly
' Them mot so lenh ma ban mong muon or bo bot tuy vao nhu cau
End Sub
Private Sub Class_Terminate()
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Private Sub Class_Initialize()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim ChuoiKetnoi As String
ChuoiKetnoi = "Provider = SQLOLEDB;Data Source=222.254.241.8,1433;Initial Catalog=Vanbandientu;User ID=sa;Password=begaiyeu;"
Dim Sql As String
Sql = "SELECT * FROM tblCVDen"
cn.Open ChuoiKetnoi
rs.Open Sql, cn, adOpenDynamic, adLockReadOnly
End Sub
Private Sub Class_Terminate()
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
rs.Open Sql, cn, adOpenDynamic, adLockReadOnly
rst.Open tbl, ChuoiKetnoi, adOpenKeyset, adLockOptimistic, adCmdTable
Function TestSua()
If rs.EOF Then Exit Function
rs.MoveFirst
Do Until rs.EOF
If rs.Fields("TenFile").Value = "Ten Properties" Then
mEdit = True
Exit Do
End If
rs.MoveNext
Loop
End Function
Public Sub Update()
With rst
If mEdit = True Then
.Edit
Else
.AddNew
End If
.Fields("TenCot1").Value = Ten Properties
.Fields("TenCot2").Value = Ten Properties
.Update
End With
mEdit = True
End Sub
Public Sub AddNew()
mEdit = False
End Sub
Dim cls As Tenclass
Set cls = New Tenclass
Set cls= Nothing
Dim cls As clsKhachhang
Set cls = New clsKhachhang
With cls
.IDKhachhang = Nz(Me.IDKhachhang)
.Tenkhachhang = Nz(Me.Tenkhachhang)
End With
cls.TestSua
cls.Update
Set cls = Nothing
Minh Tiên > 17-12-16, 10:33 AM