Đố vui về ADO, DAO.

Liên hệ QC
Nếu không xét vấn đền font thì tôi viết như sau:

PHP:
Sub DoVui()
    With CreateObject("ADODB.Connection")
        .Open "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName
        Sheet2.[a2].CopyFromRecordset .Execute("Select * From [Sheet1$]")
    End With
    
End Sub
Hay...xúc tích ngắn gọn ...Bạn chỉ cho cách xử lý Font đi
Xin cảm ơn
 
Nếu không xét vấn đền font thì tôi viết như sau:

PHP:
Sub DoVui()
    With CreateObject("ADODB.Connection")
        .Open "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName
        Sheet2.[a2].CopyFromRecordset .Execute("Select * From [Sheet1$]")
    End With
    
End Sub
Sao mình thử chạy code này mà nó báo lỗi nhỉ?
Capture.jpg
 
To quangluu1989
Sao rồi nghĩ ra cách làm bài #240 chưa vậy
 
Vẫn còn nhiều, còn có thể rút gọn được nữa.

Vậy tôi viết như sau tổng 307 kí tự không tính cách trắng:

Mã:
Sub ADO_DoVui()


    Dim v As String
    v = Application.Version
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
        Sheet2.[a1].CopyFromRecordset .Execute("Select * From [Sheet1$]")
    End With
    
End Sub

Tôi nghĩ còn có thể rút gọn được nữa.
 
Mình có bài toán này, mong GPE tư vấn giúp mình câu truy vấn để ra được kết quả như trong file đính kèm. Cảm ơn.

Capture.jpg
 

File đính kèm

  • Book1.xlsm
    12.4 KB · Đọc: 14
... câu truy vấn của mình dài quá, mình thấy ko tối ưu nên muốn tham khảo thêm các câu truy vấn của các bạn.

Đối với lập trình, chuyện tối ưu còn tuỳ theo quan điểm. Bạn muốn câu truy vấn ngắn, hay muốn nó hoạt động hiệu quả về tốc độ hay về tài nguyên, hay muốn nó dễ hiểu dễ sửa.

Riêng quan điểm của tôi, khi viết một câu lệnh truy vấn, dài/ngắn là điều kiện cuối cùng mà tôi trông tới.
 
Đối với lập trình, chuyện tối ưu còn tuỳ theo quan điểm. Bạn muốn câu truy vấn ngắn, hay muốn nó hoạt động hiệu quả về tốc độ hay về tài nguyên, hay muốn nó dễ hiểu dễ sửa.

Riêng quan điểm của tôi, khi viết một câu lệnh truy vấn, dài/ngắn là điều kiện cuối cùng mà tôi trông tới.
Cảm ơn bạn đã góp ý. Vấn đề của mình là truy vấn không tối ưu (chạy rất chậm), dữ liệu có 60 dòng thui mà cũng mất khoảng 1s, 100 dòng mất 2.5s.
 
Mình có bài toán này, mong GPE tư vấn giúp mình câu truy vấn để ra được kết quả như trong file đính kèm. Cảm ơn.

View attachment 165692
Mình đã thay đổi truy vấn, tốc độ được cải thiện rất nhiều rùi (100 dòng dữ liệu mất 0.02s, chỉ thay đổi subquery thành table để join thui mà khác hẳn, hic), vậy bạn nào có nhã hứng tham gia giải bài toán này nha.
 
Lần chỉnh sửa cuối:
Các bạn giúp mình xử lý sự cố ADO này ạ: ADO tổng hợp công nợ chạy trên excel 2003 hoàn toàn bình thường, khi mình save as thành đuôi .xlsm thì báo lổi như sau:
The Microsoft Access database engine could not find the object 'PSNC'. Make sure the object exists and that you spell its name and the path name correctly. if 'PSNC' is not a local object, check your network connection or contact the server administator
Mình thử kiểm tra vùng PSNC thấy vẫn tồn tại bình thường, không hiểu sao lại báo lổi như thế

Cám ơn các bạn
 
Chỉnh sửa lần cuối bởi điều hành viên:
Các bạn giúp mình xử lý sự cố ADO này ạ: ADO tổng hợp công nợ chạy trên excel 2003 hoàn toàn bình thường, khi mình save as thành đuôi .xlsm thì báo lổi như sau:
The Microsoft Access database engine could not find the object 'PSNC'. Make sure the object exists and that you spell its name and the path name correctly. if 'PSNC' is not a local object, check your network connection or contact the server administator
Mình thử kiểm tra vùng PSNC thấy vẫn tồn tại bình thường, không hiểu sao lại báo lổi như thế

Cám ơn các bạn
Xem lại trong code mà bạn khai báo cái đường dẫn, phải thay đổi từ PSNC.xls sang PSNC.xlsm
 
Cám ơn bác Hai Lúa, mình đã tìm ra vấn đề, do sheet chứa vùng PSNC đặt tên là tmp, mình đoán có lẽ trùng tên với đường dẫn nào của của object ADO
 
2 cách dùng ADO mà tôi biết (có thể có các cách khác tôi không biết)

1. Dùng ADO Exlensions của DDLS (ADOX) để đọc Catalog

Mã:
Sub GetSheetNames1()

Dim cn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim t As ADOX.Table

Set cn = New ADODB.Connection
cn.Open "Provider=MSDASQL.1;Data Source=Excel Files;" _
& "Initial Catalog=C:\Junks\Test Book.xls"
Set cat = New ADOX.Catalog
Set cat.ActiveConnection = cn
For Each t In cat.Tables
Debug.Print t.Name
Next t
Set cat = Nothing
cn.Close
Set cn = Nothing
End Sub

2. Dùng hàm OpenSchema và tham số adSchemaTables để load schema vào một string rồi parse string đó để lấy tên sheet

Mã:
Sub GetSheetNames2()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Set cn = GetExcelConnection("C:\Junks\Test Book.xls")
Set rs = cn.OpenSchema(adSchemaTables)

Do While Not rs.EOF
    strTable = rs.Fields("table_name").Value
    If Right$(strTable, 1) = "$" Then ' sheet name
        strWorksheetList = strWorksheetList & vbCrLf & strTable
    Else ' range name
        strRangeList = strRangeList & vbCrLf & strTable
    End If
    rs.MoveNext
Loop
Debug.Print "Worksheets:" & strWorksheetList & vbCrLf & vbCrLf & "Ranges:" & strRangeList
End Sub

Private Function GetExcelConnection(ByVal Path As String, _
    Optional ByVal Headers As Boolean = True) As Connection
    Dim strConn As String
    Dim objConn As ADODB.Connection
    Set objConn = New ADODB.Connection
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & Path & ";" & _
              "Extended Properties=""Excel 8.0;HDR=" & _
              IIf(Headers, "Yes", "No") & """"
    objConn.Open strConn
    Set GetExcelConnection = objConn
End Function

Cả 2 cách đều lấy tên sheet theo thứ tự abc. Làm thế nào để biết sheet đầu tiên thì tôi lười quá chưa nghĩ ra.

Theo tôi biết, Catalog và Schema đọc tên sheet từ ISAM table cho nên bắt buộc phải theo thứ tự index của ISAM.

Cho em hỏi các anh đánh dấu mục nào trong References để cho code không bị lỗi
Dim cat As ADOX.Catalog
Em xin chân thành cảm ơn
 
Cho em hỏi các anh đánh dấu mục nào trong References để cho code không bị lỗi
Dim cat As ADOX.Catalog
Em xin chân thành cảm ơn

Thử vầy xem
Mã:
Public Sub Check_ADOX()
    Rem Microsoft ADO Ext. 2.8 for DDL and Security
    On Error GoTo Thoat
    ThisWorkbook.VBProject.References.AddFromGuid _
    GUID:="{00000600-0000-0010-8000-00AA006D2EA4}", Major:=2, Minor:=8
Thoat:
End Sub
 
còn dụ này nữa nếu kết nối file 2003 thì ok
mà kết nối file 2010 thì báo lỗi
Mã:
Sub LayTenSheet2010()   
   
    Dim Dbs  As Object, db As Object, tbl As Object
    Set Dbs = CreateObject("DAO.DBEngine.36")
    Set db = Dbs.OpenDatabase("D:\test.xlsx", False, True, "Excel 12.0;")
    For Each tbl In db.TableDefs
        If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
            MsgBox tbl.Name
        End If
    Next tbl
    db.Close
    Set Dbs = Nothing: Set db = Nothing: Set tbl = Nothing
End Sub
lỗi tại dòng này
Set db = Dbs.OpenDatabase("D:\test.xlsx", False, True, "Excel 12.0;")
với thông báo là
could not find installable isam
không biết lỗi đây là thiếu file nào? xin được giải thích dùm, xin chân thành cảm ơn tất cả các thành viên GPE
 
Web KT
Back
Top Bottom