Xin nhờ xem giúp code về ADO

Liên hệ QC
N

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
Sắp xếp theo thời gian sắp xếp theo bầu chọn
ngothanhluan đã viết:
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
Nhấp chuột vào đây để mở rộng...

Có 2 vấn đề cần sửa trong bài của bạn:

Thứ nhất, tên file không đúng: HANG HOA chứ không phải là TONG

Thứ hai, HDR=Yes chứ không phải HDR=No

Code sửa lại như sau:

Mã: 
Sub update()
    Dim cnn As ADODB.Connection
    Dim FileFullName As String
    Set cnn = New ADODB.Connection
    FileFullName = Application.ThisWorkbook.Path & "\HANG HOA.xlsm"
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
        .Open
        .Execute "UPDATE DS_HH SET TEN_SP='ALO123' WHERE MA_SP=10003;"
        MsgBox .State
    End With
End Sub
 
Upvote 0
Anh Nghĩa cho em hỏi, em muốn đưa một recordset vào trong 1 combobox hoặc một Arr để tiện sử dụng thì phải làm thế nào ạ.
 
Upvote 0
Upvote 0
Em dùng getrows() thi nó báo lỗi type miss match ngay dòng tô đỏ, còn nếu bỏ dòng đó đi thì dữ liệu combobox lại xuất hiện theo hàng ngang. Mong anh giải đáp giúp.
Mã: 
Private Sub UserForm_Activate()
    Dim arr
    Dim cnn As ADODB.Connection
    Dim rcd As ADODB.Recordset
    Dim FileFullName As String
    
    Set cnn = New ADODB.Connection
    Set rcd = New ADODB.Recordset
    
    FileFullName = Application.ThisWorkbook.Path & "\TONG.xlsm"
    
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
        .Open
    End With
    Set rcd = cnn.Execute("SELECT * FROM DS_HH")
    arr = rcd.GetRows()
    With ComboBox1
        .Clear
        .List = arr
       [COLOR=#ff0000] .List = Application.Transpose(arr)[/COLOR]
    End With
    


    Set rcd = Nothing
    cnn.Close


End Sub
 
Upvote 0
ngothanhluan đã viết:
Em dùng getrows() thi nó báo lỗi type miss match ngay dòng tô đỏ, còn nếu bỏ dòng đó đi thì dữ liệu combobox lại xuất hiện theo hàng ngang. Mong anh giải đáp giúp.
Mã: 
Private Sub UserForm_Activate()
    Dim arr
    Dim cnn As ADODB.Connection
    Dim rcd As ADODB.Recordset
    Dim FileFullName As String
    
    Set cnn = New ADODB.Connection
    Set rcd = New ADODB.Recordset
    
    FileFullName = Application.ThisWorkbook.Path & "\TONG.xlsm"
    
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
        .Open
    End With
    Set rcd = cnn.Execute("SELECT * FROM DS_HH")
  [B][COLOR=#ff0000]  arr = rcd.GetRows()
    With ComboBox1
        .Clear
        .List = arr
        .List = Application.Transpose(arr)
    End With[/COLOR][/B]
    


    Set rcd = Nothing
    cnn.Close


End Sub
Nhấp chuột vào đây để mở rộng...
Thử thay chổ màu đỏ như sau:

ComboBox1.Column = rcd.GetRows
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Dạ cảm ơn Anh, cho em hỏi với trường hợp muốn sắp xếp lại giá trị trong mảng thì phải làm như thế nào. Mong anh giúp.
 
Upvote 0
ngothanhluan đã viết:
Em dùng getrows() thi nó báo lỗi type miss match ngay dòng tô đỏ, còn nếu bỏ dòng đó đi thì dữ liệu combobox lại xuất hiện theo hàng ngang. Mong anh giải đáp giúp.
Mã: 
Private Sub UserForm_Activate()
    Dim arr
    Dim cnn As ADODB.Connection
    Dim rcd As ADODB.Recordset
    Dim FileFullName As String
    
    Set cnn = New ADODB.Connection
    Set rcd = New ADODB.Recordset
    
    FileFullName = Application.ThisWorkbook.Path & "\TONG.xlsm"
    
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
        .Open
    End With
    Set rcd = cnn.Execute("SELECT * FROM DS_HH")
    arr = rcd.GetRows()
    With ComboBox1
        .Clear
        .List = arr
       [COLOR=#ff0000] .List = Application.Transpose(arr)[/COLOR]
    End With
    


    Set rcd = Nothing
    cnn.Close


End Sub
Nhấp chuột vào đây để mở rộng...
Trùi ui, ai mà làm như thế!

Mã: 
Sub test()
    Dim arr
    Dim cnn As ADODB.Connection
    Dim FileFullName As String, sQL As String
    Dim rcd As ADODB.Recordset
    Set cnn = New ADODB.Connection
    Set rcd = CreateObject("ADODB.recordset")
    FileFullName = Application.ThisWorkbook.Path & "\HangHoa.xlsm"
    sQL = "SELECT * FROM DS_HH"
    cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
    cnn.Open
    rcd.Open sQL, cnn
    arr = rcd.GetRows()
    arr = WorksheetFunction.Transpose(arr)
    Sheet1.ComboBox1.List = arr
    cnn.Close
End Sub
 
Upvote 0
Upvote 0
Upvote 0
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Trùi ui, ai mà làm như thế!

Mã: 
Sub test()
    Dim arr
    Dim cnn As ADODB.Connection
    Dim FileFullName As String, sQL As String
    Dim rcd As ADODB.Recordset
    Set cnn = New ADODB.Connection
    Set rcd = CreateObject("ADODB.recordset")
    FileFullName = Application.ThisWorkbook.Path & "\HangHoa.xlsm"
    sQL = "SELECT * FROM DS_HH"
    cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
    cnn.Open
    rcd.Open sQL, cnn
    arr = rcd.GetRows()
    arr = WorksheetFunction.Transpose(arr)
    Sheet1.ComboBox1.List = arr
    cnn.Close
End Sub
Nhấp chuột vào đây để mở rộng...

Nếu dùng transpose đối với dữ liệu lớn dễ bị vỡ. Vậy thì ngoài transpose và cách qua trung gian của anh Hai Lúa ra thì còn cách nào khác để gán cho mảng nữa không ạ. Mong anh giải đáp.
 
Lần chỉnh sửa cuối:
Upvote 0
ngothanhluan đã viết:
Em có đọc mấy bài trong diễn đàn, sao thấy có ý kiến cho rằng dùng transpose đối với dữ liệu lớn dễ bị vỡ. Vậy thì ngoài transpose thì còn cách nào khác không ạ. Mong anh giải đáp.
Nhấp chuột vào đây để mở rộng...
Đó, như tôi đã nói, dùng ComboBox hay ListBox làm trung gian, hoặc dùng hàm tự tạo (nhớ rằng Hai Lúa Miền Tây có post hàm này ở đâu đó).
 
Upvote 0
Chân thành Cảm ơn Anh Hai Lúa và Anh Nghĩa đã giúp ạ.
 
Upvote 0
ngothanhluan đã viết:
Chân thành Cảm ơn Anh Hai Lúa và Anh Nghĩa đã giúp ạ.
Nhấp chuột vào đây để mở rộng...
Hàm đó ở đây:

Mã: 
Function TransArr(sArr As Variant) As Variant
    Dim cllX As Long, cllY As Long, tmpX As Long, tmpY As Long, tmpArr As Variant
    tmpX = UBound(sArr, 2):    tmpY = UBound(sArr, 1)
    ReDim tmpArr(tmpX, tmpY)
    For cllX = 0 To tmpX
        For cllY = 0 To tmpY
            tmpArr(cllX, cllY) = sArr(cllY, cllX)
        Next cllY
    Next cllX
    TransArr = tmpArr
End Function

Tham khảo thêm tại đây:

http://www.giaiphapexcel.com/forum/showthread.php?75143-Bài-tập-về-ADO-căn-bản&p=463059#post463059
 
Upvote 0
Anh Nghĩa cho hỏi, em dùng liên kết đến file acces thì nó lại báo lỗi Operation must use an updatetable query.Không biết câu lệnh bị sai chỗ nào mong anh giải đáp giúp. Em có gửi file đính kèm lên.
Mã: 
Sub KET_NOI_DU_LIEU_ACC()
Dim sPath As String
Dim cnnacc As New ADODB.Connection


      sPath = Application.ThisWorkbook.Path & "\TONG.accdb"
    
    With cnnacc
    
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & sPath _
                & ";Extended Properties="";HDR=NO"";"
        .Open
        
    End With
    Set rcd = cnnacc.Execute("SELECT MAX(MA_KH) FROM DS_KH")
    maxmaKH = rcd.GetString()


    cnnacc.Execute ("INSERT INTO DS_KH(MA_KH) VALUES('" & maxmaKH + 1 & "')")
    
    cnnacc.Close
    
End Sub
 

File đính kèm

  • BH.rar
    101.4 KB · Đọc: 21
Upvote 0
ngothanhluan đã viết:
Anh Nghĩa cho hỏi, em dùng liên kết đến file acces thì nó lại báo lỗi Operation must use an updatetable query.Không biết câu lệnh bị sai chỗ nào mong anh giải đáp giúp. Em có gửi file đính kèm lên.
Mã: 
Sub KET_NOI_DU_LIEU_ACC()
Dim sPath As String
Dim cnnacc As New ADODB.Connection


      sPath = Application.ThisWorkbook.Path & "\TONG.accdb"
    
    With cnnacc
    
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & sPath _
                & ";Extended Properties="";[B][COLOR=#ff0000]HDR=NO[/COLOR][/B]"";"
        .Open
        
    End With
    Set rcd = cnnacc.Execute("SELECT MAX(MA_KH) FROM DS_KH")
    maxmaKH = rcd.GetString()


    cnnacc.Execute ("INSERT INTO DS_KH(MA_KH) VALUES('" & maxmaKH + 1 & "')")
    
    cnnacc.Close
    
End Sub
Nhấp chuột vào đây để mở rộng...

Làm ơn cho xin chữ này đi: HDR=YES

Hôm trước đã đề cập rồi! Có tiêu đề cột thì Yes, Không thì No. Vậy đi nha.
 
Upvote 0
máy tôi dùng code bài #17 không chỉnh sửa gì code chạy ào ào mới ghê

2f879204222492f145521c4cbe27b87c.png
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

LuuAnh980
Công thức lọc không trùng đơn hàng.
Trả lời
16
Đọc
231
LuuAnh980
LuuAnh980
P
Tổng hợp dữ liệu có điều kiện tại 1 sheet khác
Trả lời
1
Đọc
33
giaiphap
giaiphap
vova2209
Hàm if điều kiện mảng
Trả lời
15
Đọc
252
VetMini
V
A
Trích lọc vùng dữ liệu với nhiều điều kiện
Trả lời
0
Đọc
24
August93
A
Kiều Mạnh
Mã nguồn Add-Ins *.xll trên Delphi cho Excel
    • Thích
    • Cảm ơn
2
Trả lời
37
Đọc
4K
giaiphap
giaiphap
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom