Xin nhờ xem giúp code về ADO

Liên hệ QC

ngothanhluan

Thành viên chính thức
Tham gia
25/6/13
Bài viết
70
Được thích
3
Em có 2 file, 1 file HANG HOA chứa dữ liệu hàng hóa, 1 file kia dùng để lấy hoặc chỉnh sửa dữ liệu, file TEST em có viết đoạn code ADO như sau nhưng bị báo lỗi, không biết bị sai chỗ nào mong mọi người giúp đỡ.
Mã:
Sub update()    
Dim cnn As ADODB.Connection
    Dim FileFullName As String
    Set cnn = New ADODB.Connection
    
    FileFullName = Application.ThisWorkbook.Path & "\TONG.xlsm"
    
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=No"";"
        .Open
    End With
    cnn.Execute ("UPDATE DS_HH SET TEN_SP='ALO123' WHERE MA_SP=10003")
    MsgBox cnn.State
End Sub
 

File đính kèm

  • HANG HOA.xlsm
    40.3 KB · Đọc: 32
  • TEST.xlsm
    14.7 KB · Đọc: 34
Đúng là thế, mình không nói mình là dân chuyên nghiệp nhưng thường các phần mềm lớn người ta cũng làm thế.

@ngothanhluan:
Nếu CSDL là access thì tôi cũng đã từng làm có thể gặp lỗi khi 2 người cùng truy cập vào 1 dòng dữ liệu.
Nếu CSDL lớn sao không chọn giải pháp là SQLServer hay là MySQL?
Anh Hai Lúa cho em hỏi thêm là khi 2 người cùng ghi dữ liệu vào file Access cùng 1 lúc thì mình có thể bẫy lỗi được không ạ. Ví dụ như msgbox "Qua trinh ghi du lieu gap loi, Vui long thuc hien lai!". Mong anh giải đáp giúp em.
 
Upvote 0
Cái của em là trường hợp 1 có anh Nghĩa ơi, Vì mỗi lần ENTER ở một textbox thì nó phải chạy lại trên dữ liệu nguồn và với điều kiện là 8 cái textbox trên. Bởi vậy nên em mới làm cái sub đó để loại bớt những textbox rỗng đó anh. Nhưng không hiểu sao nó lại báo lỗi ngay cái Arrcrit() mong anh giải đáp giúp.
Bây giờ tôi làm luôn cái trường hợp 2 cho bạn luôn đây!

Nếu muốn lọc 1 cái thì đảm bảo mỗi cái textbox được lọc có giá trị, các textbox khác phải rỗng

Và nếu các textbox khác, kể cả 8 cái cùng có giá trị thì sẽ lọc theo kiểu AND, có nghĩa là lọc hết.

Tôi viết cho bạn cái Module riêng như sau:

Mã:
Function ChuyenCotThanhHang(ByVal sArray As Variant) As Variant
    ''Ham ChuyenCotThanhHang nhan mang co can nhu the nao thi
    ''se tra lai mang 2 chieu co can nhu the ay.
    ''sArray: Mang xuat ra tu ADO: GetRows()
    ''Mang nay co can hang bang 0, can cot bang 0
    
    Dim tmpArr As Variant
    Dim i As Long, j As Long
    
    Dim lCol As Long, lRow As Long
    Dim uCol As Long, uRow As Long
    
    lRow = LBound(sArray, 1)
    lCol = LBound(sArray, 2)
    
    uRow = UBound(sArray, 1)
    uCol = UBound(sArray, 2)
    
    ReDim tmpArr(lCol To uCol, lRow To uRow)
    
    For i = lCol To uCol
        For j = lRow To uRow
            tmpArr(i, j) = sArray(j, i)
        Next
    Next
    
    ChuyenCotThanhHang = tmpArr
    
End Function




Function LocMang2Chieu(ByVal MangNguon2Chieu, ByVal SoThuTuCot As Byte, ByVal DieuKien As String) As Variant
    ''MangNguon2Chieu(): Bat buoc la mang 2 chieu, hoac can dau la 0 (dang MangNguon2Chieu(0 to m, 0 to n)
                        ''Hoac can dau la 1 (dang MangNguon2Chieu(1 to m, 1 to n)
    ''SoThuTuCot: Neu mang co can dau cua cot la 0 thi cot dau tien se la 0, nguoc lai se chinh la 1.
    
    Dim GetRow(), tmpArr()
    Dim lCol As Long, lRow As Long
    Dim uCol As Long, uRow As Long
    Dim c As Long, n As Long, r As Long
    
    lRow = LBound(MangNguon2Chieu, 1)
    lCol = LBound(MangNguon2Chieu, 2)


    uRow = UBound(MangNguon2Chieu, 1)
    uCol = UBound(MangNguon2Chieu, 2)
    
    For r = lRow To uRow
        If UCase(MangNguon2Chieu(r, SoThuTuCot)) Like "*" & DieuKien & "*" Then
            n = n + 1
            ReDim Preserve GetRow(1 To n)
            GetRow(n) = r
        End If
    Next
    
    If n Then
        Dim IsCheck As Boolean
        IsCheck = (lRow = 0)
        n = n + IsCheck
        ReDim tmpArr(lRow To n, lCol To uCol)
        For r = lRow To n
            For c = lCol To uCol
                tmpArr(r, c) = MangNguon2Chieu(GetRow(r - IsCheck), c)
            Next
        Next
        LocMang2Chieu = tmpArr
    End If
End Function

Và code trên Form tôi sửa lại như sau:

Mã:
Private Sub UserForm_Initialize()
    tmpStr = Month(Date) & "/" & Year(Date)
    Call DS_PT
End Sub


Private Sub DS_PT() 'lay danh sach phieu thu tu tbl PHIEU_THU
Dim sPath As String
Dim cnnAccS As ADODB.Connection
Dim rcdTEMP As ADODB.Recordset
    Set cnnAccS = New ADODB.Connection
    With cnnAccS
    sPath = Application.ThisWorkbook.Path & "\" & sName & ".accdb"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & sPath _
                & ";Extended Properties="";HDR=Yes"";"
        .Open
    End With
    Set rcdTEMP = New ADODB.Recordset
    Set rcdTEMP = cnnAccS.Execute("SELECT MA_PHIEU,NGAY_THANG,MA_KH,TEN_KH,FORMAT(DA_THU,'#,###')," & _
                                        "CHUNG_TU_GOC,NHOM_SP,HINH_THUC,NGAN_HANG," & _
                                        "GHI_CHU,TEN_NVKD,MA_NVKD " & _
                                    "FROM PHIEU_THU WHERE NGAY_THANG LIKE '%" & tmpStr & "%'")
[COLOR=#ff0000][B]    DSPTArray = ChuyenCotThanhHang(rcdTEMP.GetRows())[/B][/COLOR]
    ListBox1.List() = DSPTArray
    Set rcdTEMP = Nothing
    cnnAccS.Close
End Sub

Và thủ tục chính trong form đó như sau:

Sự kiện của TextBox:

Mã:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Call LocKieuMoi
    If priIsFocus Then
        Cancel = True
    End If
End Sub

Thủ tục chạy:

Mã:
Sub LocKieuMoi()
priIsFocus = False
    Dim i As Byte, n As Byte
    Dim ArrCol(), tmpArr
    Dim ArrSub(0 To 1)
    Dim ArrSum()
    ArrCol = Array(0, 1, 3, 5, 6, 7, 8, 10)
    For i = 1 To 8
        If Trim(Me("TextBox" & i).Text) > "" Then
            n = n + 1
            ArrSub(0) = ArrCol(i - 1)
            ArrSub(1) = UCase(Trim(Me("TextBox" & i).Text))
            ReDim Preserve ArrSum(1 To n)
            ArrSum(n) = ArrSub
        End If
    Next
    If n Then
        For i = 1 To n
            Dim ArrTmp As Variant
            If i = 1 Then
                ArrTmp = LocMang2Chieu(DSPTArray, ArrSum(1)(0), ArrSum(1)(1))
                If IsArray(ArrTmp) Then
                    tmpArr = ArrTmp
                Else
                    GoTo ExitSub
                End If
            Else
                ArrTmp = LocMang2Chieu(tmpArr, ArrSum(i)(0), ArrSum(i)(1))
                If IsArray(ArrTmp) Then
                    tmpArr = ArrTmp
                Else
                    GoTo ExitSub
                End If
            End If
        Next
        ListBox1.List = tmpArr
    Else
        If UBound(DSPTArray) > ListBox1.ListCount - 1 Then
            ListBox1.List = DSPTArray
        End If
    End If
    Exit Sub
ExitSub:
MsgBox "Mot trong cac dieu kien cua ban khong hop ly!"
priIsFocus = True
End Sub

Tôi cũng thêm 1 Label, Khi hủy bỏ việc lọc ListBox trả lại trạng thái ban đầu:

Mã:
Private Sub lblClearFilter_Click()
    If UBound(DSPTArray) > ListBox1.ListCount - 1 Then
        ListBox1.List = DSPTArray
    End If
End Sub
 

File đính kèm

  • LocDuLieu_HTN.xlsm
    73.1 KB · Đọc: 20
Upvote 0
Dạ Em cảm ơn Anh Nghĩa nhiều ạ.
Bổ sung cái Label Hủy Filter lại nha bạn:

Mã:
Private Sub lblClearFilter_Click()
    If UBound(DSPTArray) > ListBox1.ListCount - 1 Then
        Dim i As Byte
        For i = 1 To 8
            Me("TextBox" & i).Text = ""
        Next
        ListBox1.List = DSPTArray
    End If
End Sub
 
Upvote 0
Anh Nghĩa và Anh Hai Lúa cho em hỏi, dùng ADO kết nối tới MYSQL thông qua localhost chạy bằng xampp hoặc kết nối tới MYSQL trên hosting công ty thuê được không ạ. Và Câu lệnh kết nối phải như thế nào, mong hai anh giúp em.
 
Upvote 0
Anh Nghĩa và Anh Hai Lúa cho em hỏi, dùng ADO kết nối tới MYSQL thông qua localhost chạy bằng xampp hoặc kết nối tới MYSQL trên hosting công ty thuê được không ạ. Và Câu lệnh kết nối phải như thế nào, mong hai anh giúp em.
Dùng ADO có thể kết nối tới MySQL trong mạng Lan cũng như qua Internet.

Mã:
[COLOR=#141823][FONT=helvetica]Sub Query_MySQL()
[/FONT][/COLOR][COLOR=#141823][FONT=helvetica]Dim cn As Object, rst As Object
Set cn = CreateObject("ADODB.Connection")
cn.Open "Driver={MySQL ODBC 5.3 ANSI Driver};Server=[COLOR=#ff0000][B]ServerNameOrHostName[/B][/COLOR];Database=[COLOR=#0000ff]DatabaseName[/COLOR];" & _
"User=[COLOR=#0000ff]YourUserName[/COLOR];Password=[COLOR=#0000ff]YourPass[/COLOR];Option=3;"
Set rst = cn.Execute("SELECT * FROM YOURTABLE")
Range("A2").CopyFromRecordset rst[/FONT][/COLOR]
[COLOR=#141823][FONT=helvetica]End Sub[/FONT][/COLOR]

1. Đối với mạng lan (localhost): Chổ màu đỏ bạn thay vào địa chỉ địa chỉ IP của máy cài MySQL. Lưu ý là bạn phải cấu hình cho phép kết nối từ ngoài vào. Sao không cài hẳn cái MySQL vào luôn mà phải qua xampp, không khéo coi chừng bị virus nhé.
2. Kết nối qua mạng Internet thông qua hosting thì bạn nên kiểm tra xem cái gói thuê hosting đó có MySQL hay là không. Nếu có thì cung cấp vào những chổ tô đỏ và xanh ở trên là được.
 
Upvote 0
Anh Hai Lúa cho em hỏi em vào trang chủ MySQL thì thấy có nhiều cái quá không biết load cái nào, nào là MySQL on Windows, MySQL community Server..., Mong anh Hai Lúa hướng dẫn giúp ạ.
 
Upvote 0
Upvote 0
Anh Hai Lúa cho em hỏi, mấy cái provider dùng để kết nối trong excel mình lấy ở đâu ra ạ. Có trang nói rõ và liệt kê công dụng của từng cái được không anh. Em muốn tìm hiểu sâu hơn ạ. Mong anh giúp.
 
Upvote 0
Upvote 0
Em xin hỏi, file excel em đang xây dựng dùng để ghi, trích xuất dữ liệu trên host đang thuê thì tốc độ như thế nào và phụ thuộc vào những gì ạ.
 
Upvote 0
Em xin hỏi, file excel em đang xây dựng dùng để ghi, trích xuất dữ liệu trên host đang thuê thì tốc độ như thế nào và phụ thuộc vào những gì ạ.
Dĩ nhiên là phụ thuộc vào tốc độ đường truyền + CSDL truy vấn là nhiều bản ghi hay ít, số lượng thành viên đăng nhập...
 
Upvote 0
Em xin hỏi một tí về Function trong SQL ạ, em có đoạn code sau để lấy STT max dùng để ghép chuỗi tạo mã đơn hàng nhưng nó cứ báo lỗi code 1054 unknow column idphieu_xuat in list field hoài. Mong anh xem thử ạ.
Mã:
CREATE DEFINER=`root`@`localhost` FUNCTION `MAX_ID`(id varchar(45),tbl varchar(45)) RETURNS int(11)
BEGIN
declare idmax integer;
    set idmax=(select max(id) from tbl);
    return idmax=idmax+1;
END
sau đó em dùng lệnh như sau:
Mã:
INSERT INTO phieu_xuat(idphieu_xuat) values(MAX_ID(idphieu_xuat,phieu_xuat))
em không biết bị lỗi chỗ nào mong anh Hai Lúa giúp.
Code trên em thực hiện trực tiếp trong MySQL luôn ạ.
 
Upvote 0
Em xin hỏi, file excel em đang xây dựng dùng để ghi, trích xuất dữ liệu trên host đang thuê thì tốc độ như thế nào và phụ thuộc vào những gì ạ.

Nếu trên máy của bạn thì lần đầu tiên kết nói sẽ lâu, vì hệ thống phải giải quyết những thủ tục. Nhưng những lần kế tiếp sẽ nhanh hơn vì đường kết nối còn giứ đó. Hoặc nếu đường kết nối đã cắt thì hệ thống cũng đã biết và nhớ hầu hết điều kiện rồi.

Trên Server thuê thì rất phức tạp. Server có khả năng giữ hoặc nhớ đường kết nối, nhưng vì là server thuê cho nên phải tuỳ theo họ giành cho bạn những quyền lợi gì.
 
Upvote 0
Nếu trên máy của bạn thì lần đầu tiên kết nói sẽ lâu, vì hệ thống phải giải quyết những thủ tục. Nhưng những lần kế tiếp sẽ nhanh hơn vì đường kết nối còn giứ đó. Hoặc nếu đường kết nối đã cắt thì hệ thống cũng đã biết và nhớ hầu hết điều kiện rồi.

Trên Server thuê thì rất phức tạp. Server có khả năng giữ hoặc nhớ đường kết nối, nhưng vì là server thuê cho nên phải tuỳ theo họ giành cho bạn những quyền lợi gì.
Anh VetMiNi cho em hỏi, vậy giữa việc tính toán trên server rồi đưa xuống máy và việc đưa xuống máy tính toán rồi mới đưa lên server thì bên nào lợi hơn và lợi hơn về cái gì ạ. Cụ thể là đoạn code em lấy MAX_ID như bài #74 ạ. Nếu đưa xuống máy thì em phải lấy record tới 2 lần ạ.
 
Upvote 0
CSDL có cách bảo đảm nguyên vẹn transaction của nó (qua những lệnh như commit, rollback). Đưa xuống máy thì làm cách nào bạn bảo đảm?

Vả lại, CSDL luôn luôn có cách tối ưu hoá của nó. 99% trường hợp là cái nào nó tính được thì cứ để cho nó tính.

Một trong những trường hợp đặc thù mà bạn phải tải về, tính trên máy mình là trường hợp phải duyệt từng record. Nhất là nếu phải dùng con trỏ. Con trỏ trong CSDL LH chạy rất tốn kém.

Đó là nói chung thôi. Chứ cách sử lý còn tuỳ thuộc vào trường hợp nhiều người dùng, bạn có thể bị locked recrods, và cần phải sử lý snapshot.
 
Upvote 0
Hiện em thấy có chức năng lưu file ảnh bằng định dạng OLE Objects trong Access nên nảy ra ý tưởng lưu dữ liệu hình ảnh khách hàng lên file rồi dùng ADO lấy hình đưa lên form trong excel nhưng không biết làm sao. Mong Anh Hai Lúa đi ngang vào giúp đỡ.
 
Upvote 0
Hiện em thấy có chức năng lưu file ảnh bằng định dạng OLE Objects trong Access nên nảy ra ý tưởng lưu dữ liệu hình ảnh khách hàng lên file rồi dùng ADO lấy hình đưa lên form trong excel nhưng không biết làm sao. Mong Anh Hai Lúa đi ngang vào giúp đỡ.
Thường thì người ta sẽ lưu đường dẫn đế chổ chứa hình, sau đó đọc hình từ đường dẫn là được. Cách này đỡ tốn dung lượng chứa hình vào file hơn.

Code ví dụ như sau:
Mã:
Option Explicit

Private Sub ListBox1_Change()
   Dim lItem As Long
    For lItem = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(lItem) = True Then
            Image1.Picture = LoadPicture(ThisWorkbook.Path & ListBox1.List(ListBox1.ListIndex, 2))
        End If
    Next
End Sub
Private Sub UserForm_Initialize()
    Dim cn As Object, rst As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Driver={Microsoft Access Driver (*.mdb)};Dbq=" & ThisWorkbook.Path & "\data.mdb;Uid=Admin;Pwd=;")
    Set rst = cn.Execute("select * from [tbl_Hinh]")
    If Not (rst.bof And rst.EOF) Then
        Me.ListBox1.ColumnCount = rst.Fields.Count
        Me.ListBox1.Column = rst.getrows()
        rst.Close
    End If
End Sub

1.jpg

Tải file và giải nén, sau đó mở file FileTest.xls nhé.
 

File đính kèm

  • Hinh.rar
    61.4 KB · Đọc: 28
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom