Thảo luận về bài: ADO căn bản "Kết nối truy vấn CSDL từ file Excel đến file Access."

Liên hệ QC

ThuNghi

Hãy cho rồi sẽ nhận!
Thành viên đã mất
Tham gia
16/8/06
Bài viết
3,808
Được thích
4,448
Để topic ADO căn bản: Kết nối truy vấn CSDL từ file Excel đến file Access. được liên tục, các bạn nếu có thảo luận xin thảo luận ở đây nhé

----------
Ta có file tblData gồm 20 field và hiển nhiên ta có thể có danh sách field Name như sau:
- ArrFieldName=Arr("A","B",...,"X")
Vậy có thế viết dòng code để lấy câu SQL chỉ lấy field 1,3, 12 thôi, tránh nhập sai tên field thì thế nào trong câu select sau.
Có thể viết code tạo câu SQL?
lsSQL = "SELECT SUPPLIER, [MATERIAL NAME], [COLOR NAME] " & _
"FROM tblData"
Cám ơn.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Code kết nối với CSDL ví dụ file Access có tên là CSDL.mdb với Pass là 1234 , code kết nối sẽ như sau:

Mã:
Public cnn As New ADODB.Connection
Sub Moketnoi()
Set cnn = New ADODB.Connection
Dim strCNString As String
strCNString = "Data Source=" & ThisWorkbook.Path & "\CSDL.mdb"
With cnn
    [COLOR=#ff0000].Provider = "Microsoft Jet 4.0 OLE DB Provider"[/COLOR]
    [COLOR=#ff0000].ConnectionString = strCNString[/COLOR]
    .Properties("Jet OLEDB:Database Password") = "1234"
    [COLOR=#ff0000].CursorLocation = adUseClient[/COLOR]
    .Open

End With

End Sub
.
Nếu có thời gian Hai Lúa vui lòng giải thích thêm mấy dòng màu đỏ trên với
Mã:
.ConnectionString = strCNString
.CursorLocation = adUseClient
Mấy cái này dùng để làm gì? Không có nó có được không?
Còn cái này:
Mã:
.Provider = "Microsoft Jet 4.0 OLE DB Provider"
Liệu có liên quan đến version Office không?
 
Xin hỏi ngoài lề, sau đó nhờ SMod xóa.
Ta có file tblData gồm 20 field và hiển nhiên ta có thể có danh sách field Name như sau:
- ArrFieldName=Arr("A","B",...,"X")
Vậy có thế viết dòng code để lấy câu SQL chỉ lấy field 1,3, 12 thôi, tránh nhập sai tên field thì thế nào trong câu select sau.
Có thể viết code tạo câu SQL?

Cám ơn.
Anh thử như sau nhé.

ArrFieldName= Array("ID", "PONO", "W_HDATE", "TP", "[MATERIAL NAME]", "[SPEC 2]", "[COLOR NAME]", "POQTY", "INPUTQTY", "BALANCE", "UNIT", "PRICE", "M_UNIT", "AMOUNT", "ORIGIN", "SUPPLIER", "REMARK")
lsSQL = "SELECT " & ArrFieldName(15) & "," & ArrFieldName(4) & "," & ArrFieldName(6) & " " & _
"FROM tblData"

Nếu có thời gian Hai Lúa vui lòng giải thích thêm mấy dòng màu đỏ trên với
Mã:
.ConnectionString = strCNString '
.CursorLocation = adUseClient
Mấy cái này dùng để làm gì? Không có nó có được không?
Còn cái này:
Mã:
.Provider = "Microsoft Jet 4.0 OLE DB Provider"
Liệu có liên quan đến version Office không?

.ConnectionString = strCNString
Nó là

.ConnectionString ="Data Source=" & ThisWorkbook.Path & "\CSDL.mdb"

==> Đường dẫn kết nối với CSDL, nếu không có sẽ không được Thầy à.

.Provider = "Microsoft Jet 4.0 OLE DB Provider"
==> Thầy tham khảo link http://msdn.microsoft.com/en-us/library/office/aa140022(v=office.10).aspx

.CursorLocation = adUseClient
==> Thầy tham khảo link http://visualbasic.freetutes.com/learn-vb6-advanced/lesson9/p13.html
 
Lần chỉnh sửa cuối:
Hãy tiếp tục đề tài này đi Hai Lúa Miền Tây! Đề tài này rất hữu ích.

1./ Lấy tất cả các cột có trong bảng:

Mã:
Sub LayDuLieuTatCaCot()
On Error GoTo loi


Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State <> 1 Then Moketnoi


    lsSQL = "SELECT * " & _
            "FROM tblData"
            
    rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
    Cells.ClearContents
    [SIZE=4][COLOR=#0000cd][B]Range("A5").CopyFromRecordset [/B][/COLOR][COLOR=#ff0000][B]rst[/B][/COLOR][/SIZE]
    
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
loi:
MsgBox Err.Description
End Sub

Giả sử rst chỉ có 1 giá trị và giá trị đó mình muốn nó hiện trên MsgBox mà không thông qua copy ở đâu đó, tức là chuyển trực tiếp giá trị có được từ rst lên MsgBox thì phải làm sao?
 
Chỉnh sửa lần cuối bởi điều hành viên:
1./ Hãy tiếp tục đề tài này đi Hai Lúa Miền Tây! Đề tài này rất hữu ích.
2./ Giả sử rst chỉ có 1 giá trị và giá trị đó mình muốn nó hiện trên MsgBox mà không thông qua copy ở đâu đó, tức là chuyển trực tiếp giá trị có được từ rst lên MsgBox thì phải làm sao?
3./ Em thử rồi Thầy ơi, bị lỗi!
1./ Nếu các anh chị quan tâm và không chê em hứa sẽ tiếp tục.
2./ Anh muốn cái MsgBox đó hiển thỉ giá trị 1 cột hay là nhiều cột, từng giá trị có trong từng cell?
3./ Cho em xem thử đoạn code của anh được không?
 
1./ Nếu các anh chị quan tâm và không chê em hứa sẽ tiếp tục.
2./ Anh muốn cái MsgBox đó hiển thỉ giá trị 1 cột hay là nhiều cột, từng giá trị có trong từng cell?
3./ Cho em xem thử đoạn code của anh được không?

HÀM KẾT NỐI:

Mã:
Option Explicit
Public gcnObj As Object
Public Const DBName = "CSDLTienLuong.mdb"

Global Const adStateClosed = 0
Global Const adStateOpen = 1
Global Const adStateConnecting = 2
Global Const adStateExecuting = 4
Global Const adStateFetching = 8
[COLOR=#006400]''=========================================================================================[/COLOR]

Function ConnectingString() As String
    Dim sAppPath As String
    sAppPath = ThisWorkbook.Path
    ConnectingString = "Driver={Microsoft Access Driver (*.mdb)}; Dbq=" & sAppPath & "\" & DBName & "; UID=Admin; PWD=;"
End Function
[COLOR=#006400]''=========================================================================================[/COLOR]

Function AccConn() As Boolean
    On Error GoTo ErrorHandle
    Set gcnObj = CreateObject("ADODB.Connection")
    With gcnObj
        .Mode = 3
        .ConnectionTimeout = 30
        .CursorLocation = 3
        .ConnectionString = ConnectingString()
        .Open
    End With
    
    AccConn = True
    gcnObj.Close

ErrorExit:
    Exit Function
    
ErrorHandle:
    AccConn = False
    Err.Clear
    Resume ErrorExit
End Function

THỦ TỤC MUỐN GÁN VÀO MSGBOX:

Mã:
Sub AccToExKiemTraPhep()
    On Error Resume Next
    If AccConn = False Then
        MsgBox "Loi ket noi", vbOKOnly + vbExclamation, "THÔNG BÁO"
    Else
        On Error GoTo ErrorHandle
        
        Dim sSQL As String
        Dim adoCommand As Object, oRs As Object
        
        gcnObj.Open
                      
        sSQL = "SELECT Sum(NgayPhep) " _
             & "FROM TB_LuongThucTe " _
             & "WHERE MaTinhLuong = 'TM00001'"
        
        Set adoCommand = CreateObject("ADODB.Command")
        
        With adoCommand
            .CommandType = 1
            .ActiveConnection = gcnObj
            .CommandText = sSQL
        End With
            
        Set oRs = CreateObject("ADODB.Recordset")
        
        oRs.Open adoCommand, , 3, 4
        
        If oRs.EOF Then
            MsgBox "Không có record nào!", vbOKOnly + vbInformation, "THÔNG BÁO"
        Else

[COLOR=#006400]            [B]''THAY VÌ:[/B]
            ''================================================================[/COLOR]

[COLOR=#0000cd]            Dim Phep As Range
            Set Phep = Sheet1.Range("B1")
                Phep.Clear[/COLOR]
        
[COLOR=#0000cd]            Phep.CopyFromRecordset oRs
            MsgBox "So ngay phep da nghi la: " & Phep
            Phep.Clear
 [/COLOR]           
[B][COLOR=#006400]            ''THÌ: (KHÔNG THÔNG QUA BIẾN Phep)
[/COLOR][/B][COLOR=#006400]            ''================================================================[/COLOR][B][COLOR=#006400]
           [/COLOR][COLOR=#ff0000] ''MsgBox "So ngay phep da nghi la: " & oRs[/COLOR][COLOR=#006400]
   [/COLOR][/B]     End If
            
ErrorHandle:
        Set adoCommand = Nothing
        Set oRs = Nothing
        Set Phep = Nothing
        If Not gcnObj Is Nothing Then
            If (gcnObj.State And adStateOpen) = adStateOpen Then
                gcnObj.Close
            End If
            Set gcnObj = Nothing
        End If
    End If
End Sub
 

File đính kèm

  • AccToEx.rar
    108 KB · Đọc: 270
Lần chỉnh sửa cuối:
Hãy tiếp tục đề tài này đi Hai Lúa Miền Tây! Đề tài này rất hữu ích.



Giả sử rst chỉ có 1 giá trị và giá trị đó mình muốn nó hiện trên MsgBox mà không thông qua copy ở đâu đó, tức là chuyển trực tiếp giá trị có được từ rst lên MsgBox thì phải làm sao?

Góp chút với A Dom nha,
1/Nếu biết chắc rst chỉ có 1 giá trị (1 record) thì có thể

Mã:
...........
rst.movefirst
msgbox rst.fields(0)
...........

(Mình chưa test vì không có mẫu, lâu quá không nhớ là fields(0) hay Fields(1) nữa )

2/Nếu không chắc thì phải làm như sau:

Mã:
.........................
dim Tb as string
rst.movefist
do while not rst.eof()
tb=tb& rst.fields(0) & chr(10)
rst.movenext
loop
msgbox tb
........................

Code mình viết tại khung trả lời có thể không chuẩn, bạn hiệu chỉnh.
 
Theo tôi biết kết quả Rec là 1 arr thì sao chỉ lấy thành 1 biến được.
Code trên có thể vận dụng chút xíu
PHP:
if oRs.EOF Then
            MsgBox "Không có record nào!", vbOKOnly + vbInformation, "THÔNG BÁO"
        Else
          Dim Arr
          If oRs.RecordCount = 1 Then
            Arr = oRs.getrows
            MsgBox "So ngay phep da nghi la: " & Arr(0, 0)
          Else
            Exit Sub
          End If
 
Theo tôi biết kết quả Rec là 1 arr thì sao chỉ lấy thành 1 biến được.
Code trên có thể vận dụng chút xíu
PHP:
if oRs.EOF Then
            MsgBox "Không có record nào!", vbOKOnly + vbInformation, "THÔNG BÁO"
        Else
          Dim Arr
          If oRs.RecordCount = 1 Then
            Arr = oRs.getrows
            MsgBox "So ngay phep da nghi la: " & Arr(0, 0)
          Else
            Exit Sub
          End If

OK, theo cách của anh thì làm ra đúng kết quả. Chỉ vì mình nghĩ 1 giá trị thì nó không phải là mảng nên mình không gán vào (giờ mới ngộ ra nhiều vấn đề hihiil).

Sau khi kiểm tra và test thử, cả 2 cách của anh Sealand và anh ThuNghi đều cho ra kết quả đúng:

Anh Sealand:

PHP:
                oRs.MoveFirst
                MsgBox "So ngay phep da nghi la: " & oRs.Fields(0)


Anh ThuNghi:

PHP:
            Dim SoNgayPhep As Variant
                SoNgayPhep = oRs.GetRows
                MsgBox "So ngay phep da nghi la: " & SoNgayPhep(0, 0)

-----------------------------------------------------

Thử về thời gian thì thấy cách của Anh Seland là nhanh hơn, có lẽ do nó thực hiện trực tiếp.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Lần chỉnh sửa cuối:
Hic, em làm thử như sau:

PHP:
Sub LayDuLieuDK()
On Error GoTo loi
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State <> 1 Then Moketnoi
    lsSQL = "SELECT * " & _
            "FROM tblData " & _
            "Where [balance] <0 and [origin] like 'VIETNAM'"
            
    rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
    Cells.ClearContents
    Range("A5").CopyFromRecordset rst
    
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
loi:
MsgBox Err.Description
End Sub
 
Thảo luận

Vì mình có thắc mắc về mệnh đề HAVING, nên đã tìm hiểu như sau:

The HAVING Clause

The HAVING clause was added to SQL because the WHERE keyword could not be used with aggregate functions.

Mệnh đề HAVING được thêm vào SQL bởi vì từ khóa WHERE không có khả năng dùng được với chức năng tổng hợp.

Cú pháp SQL HAVING:

Mã:
SELECT column_name, aggregate_function(column_name)
FROM table_name
WHERE column_name operator value
GROUP BY column_name
HAVING aggregate_function(column_name) operator value
 
Hic, em làm thử như sau:

PHP:
Sub LayDuLieuDK()
On Error GoTo loi
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State <> 1 Then Moketnoi
    lsSQL = "SELECT * " & _
            "FROM tblData " & _
            "Where [balance] <0 and [origin] like 'VIETNAM'"
            
    rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
    Cells.ClearContents
    Range("A5").CopyFromRecordset rst
    
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
loi:
MsgBox Err.Description
End Sub

Hoàn toàn chính xác.
Cũng với dữ liệu như nói ở trên các bạn tiếp tục lọc những loại vật tư của VIETNAM và có ngày W_HDATE trong khoảng từ ngày 08/06/2012 đến 20/07/2012
 
Vì mình có thắc mắc về mệnh đề HAVING, nên đã tìm hiểu như sau:

The HAVING Clause

The HAVING clause was added to SQL because the WHERE keyword could not be used with aggregate functions.

Mệnh đề HAVING được thêm vào SQL bởi vì từ khóa WHERE không có khả năng dùng được với chức năng tổng hợp.

Cú pháp SQL HAVING:

Mã:
SELECT column_name, aggregate_function(column_name)
FROM table_name
WHERE column_name operator value
GROUP BY column_name
HAVING aggregate_function(column_name) operator value
Như em đã đề cập Topic bên kia, mình có thể dùng Where nhé, Sao ở trên vừa where và vừa having? 1 loại là được rồi. Cái này em chưa đề cập là vì chưa đến phần tính toán.
 
Như em đã đề cập Topic bên kia, mình có thể dùng Where nhé, Sao ở trên vừa where và vừa having? 1 loại là được rồi. Cái này em chưa đề cập là vì chưa đến phần tính toán.

Uh, có thể mình "cầm đèn chạy trước ô tô", Hai lúa xem bài này xong thì xóa bài này và bài trước luôn nhé!

Mình trích từ trang này, tham khảo và thực hành trên file của Hai Lúa sẽ rất hay đấy:

http://www.w3schools.com/sql/sql_having.asp
 
Lần chỉnh sửa cuối:
Mình trích từ trang này, tham khảo và thực hành trên file của Hai Lúa sẽ rất hay đấy:

http://www.w3schools.com/sql/sql_having.asp
Em ví dụ trên file em nhé. Dùng where không dùng having vẫn được.

SELECT ORIGIN, Sum(AMOUNT) AS SumOfAMOUNT, TP
FROM tblData
WHERE ORIGIN Like 'KOREA' AND TP Like 'A'
GROUP BY ORIGIN, TP;

Còn dùng Having sẽ như sau:

SELECT ORIGIN, Sum(AMOUNT) AS SumOfAMOUNT, TP
FROM tblData
GROUP BY ORIGIN, TP
having ORIGIN Like 'KOREA' AND TP Like 'A'
 
Lần chỉnh sửa cuối:
Lần chỉnh sửa cuối:
Em ví dụ trên file em nhé. Dùng where không dùng having vẫn được.



Còn dùng Having sẽ như sau:
Vậy HLMT làm thử
PHP:
SELECT ORIGIN, Sum(AMOUNT) AS SumOfAMOUNT, TP
 FROM tblData
 WHERE ORIGIN Like 'KOREA' AND TP Like 'A'
 GROUP BY ORIGIN, TP;
Lọc sum(Amount) > 1000 thì phải dùng having , dùng where hình như kg OK
PHP:
SELECT ORIGIN, Sum(AMOUNT) AS SumOfAMOUNT, TP
 FROM tblData
 WHERE ORIGIN Like 'KOREA' AND TP Like 'A' and sum(AMOUNT) > 1000
 GROUP BY ORIGIN, TP;
 
Web KT
Back
Top Bottom