Sub Moketnoi()
Dim cnn As Object
Set cnn = CreateObject("ADODB.Connection")
Dim strCNString As String
strCNString = "Data Source=" & ThisWorkbook.Path & "\chuot0106.xlsx"
With cnn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& strCNString & ";Extended Properties=""Excel 12.0;"""
.Open
End With
End Sub
Có thể rút ngắn lại như sau:
Sub Moketnoi()
Dim cnn As Object
Set cnn = CreateObject("ADODB.Connection")
cnn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & ThisWorkbook.Path & "\chuot0106.xlsx" & _
";Extended Properties=""Excel 12.0;""")
End Sub
Kết nối tới Acceses)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
Range("A5").CopyFromRecordset rst
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
loi:
MsgBox Err.Description
End SubAnh huy:
Tôi nghiêng về cách giải thích của anh Huy.
Giờ trong File "ADO" tôi đã gửi, tôi muốn lấy 3 cột từ File.xls "chuot0106" sang bên File "ChapChungADO" thì code viết sao vậy các bạn? Code mẫu của anh "Hai lúa miền tây" là thế này
Giờ tôi phải sửa chỗ nào trong đoạn code này ạ?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 Range("A5").CopyFromRecordset rst rst.Close Set rst = Nothing cnn.Close Set cnn = Nothing Exit Sub loi: MsgBox Err.Description End Sub
Sub LayDL()
Dim cnn As Object, rst As Object
Set cnn = CreateObject("ADODB.Connection")
cnn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & ThisWorkbook.Path & "\chuot0106.xlsx" & _
";Extended Properties=""Excel 12.0;""")
Set rst = cnn.Execute("SELECT * FROM [SHEET1$]")
ActiveCell.CopyFromRecordset rst
End SubCảm ơn bạn nhiều lắm! Kết quả đúng như ý luôn bạn ạ! Nhưng bạn có thể viết 1 cách tường minh giúp tôi với được không bạn? Tức bạn không cần rút ngắn code đâu, bạn cứ viết như của Hai lúa miền tây đó. Do tôi đang muốn học hỏi mà, nếu đòi hỏi của tôi quá đáng quá mong bạn bỏ quá cho!
Biết là viết như của anh là "ngon cơm" rồi, tuy nhiên em đang học căn bản như anh Hai lúa viết nên nhờ anh sửa giúp từ đoạn code anh Hai lúa đã viết ở trên để em học đó mà! Cảm ơn anh!
Option Explicit
Public cnn As New ADODB.Connection
Sub Moketnoi()
Set cnn = New ADODB.Connection
Dim strCNString As String
strCNString = "Data Source=" & ThisWorkbook.Path & "chuot0106.xls"
With cnn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& strCNString & ";Extended Properties=""Excel 12.0;"""
.Open
End With
End Sub
Sub LayDuLieuTatCaCot()
On Error GoTo loi
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State <> 1 Then Moketnoi
lsSQL = "SELECT * " & _
"[COLOR=#ff0000][B]FROM [sheet1][/B][/COLOR]"
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Đúng là bị thiếu \ như anh Hậu nói, hồi xưa lúc vào diễn đàn nước ngoài cũng thấy có chữ $ tưởng họ viết nhầm, bỏ đi tèo ngay . Mình ko hiểu cái đó có ý nghĩa thế nào, không biết có phải là dữ liệu nguồn thì thêm vào để phân biệt không?
Có hai cách sau Bạn sử dụng cách nào cũng OK
Sub Check_File()
Dim FileName As String
FileName = ThisWorkbook.Path & "\chuot.xlsx"'Cách 1
FileName = ThisWorkbook.Path & "\" & "chuot.xlsx"'Cách 2
MsgBox FileName
End SubCòn dấu $ là quy định khi lấy làm việc với sheet, làm việc với Name thì không có. Tiếp bài viết của anh Hậu, FROM [Sheet1$], bạn có thể viết thành "FROM CHUOT" , CHUOT LÀ VÙNG NAME TRONG SHEET1 nhé, thì sẽ không cần $
Function GetExcelConnection(ByVal Path As String, Optional ByVal Header As Boolean = True)
Dim StrConn As String, ObjConn As Object, Pro As String, Ext As String
Set ObjConn = CreateObject("ADODB.Connection")
If Application.Version < 12 Then
Pro = "Provider=Microsoft.JET.OLEDB.4.0;"
Ext = ";Extended Properties=""Excel 8.0;"
Else
Pro = "Provider=Microsoft.ACE.OLEDB.12.0;"
Ext = ";Extended Properties=""Excel 12.0;"
End If
StrConn = Pro & "Data Source=" & Path & Ext & _
"HDR=" & IIf(Header, "Yes", "No") & ";IMEX=1"";"
ObjConn.Open StrConn
Set GetExcelConnection = ObjConn
End Function
phải chăng trí nhớ của mình quá ké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"
strCNString = "Data Source=" & ThisWorkbook.Path & "\chuot0106.xlsx"
'MsgBox strCNString
With cnn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& strCNString & ";Extended Properties=""Excel 12.0;"""
.Open
End With
End Sub
'----------------------------------------------------------------------------
Sub LayDuLieu3Cot()
On Error GoTo loi
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State <> 1 Then Moketnoi
lsSQL = "SELECT SUPPLIER, [COLOR=#ff0000][B][STT][/B][/COLOR], [COLOR=#ff0000][B][ho ten] [/B][/COLOR]" & _
"FROM [sheet1$]"
'lsSQL = "SELECT SUPPLIER, [MATERIAL NAME], [COLOR NAME] " & _
"FROM tblData"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
Cells.ClearContents
Range("E1").CopyFromRecordset rst
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
loi:
MsgBox Err.Description
End SubPublic cnn As New ADODB.Connection
Sub Moketnoi()
Set cnn = New ADODB.Connection
Dim strCNString As String
'strCNString = "Data Source=" & ThisWorkbook.Path & "\CSDL.mdb"
strCNString = "Data Source=" & ThisWorkbook.Path & "\chuot0106.xlsx"
'MsgBox strCNString
With cnn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& strCNString & ";Extended Properties=""Excel 12.0;"""
.Open
End With
End Sub
'----------------------------------------------------------------------------
Sub LayDuLieu3Cot()
On Error GoTo loi
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State <> 1 Then Moketnoi
lsSQL = "SELECT SUPPLIER, [COLOR=#ff0000][B][STT][/B][/COLOR], [COLOR=#ff0000][B][ho ten] [/B][/COLOR]" & _
"FROM [sheet1$]"
'lsSQL = "SELECT SUPPLIER, [MATERIAL NAME], [COLOR NAME] " & _
"FROM tblData"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
Cells.ClearContents
Range("E1").CopyFromRecordset rst
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
loi:
MsgBox Err.Description
End SubBiến Recordset là rst chứ không phải lrs, thay bằng rst.fields là được. Ngoài ra câu lệnh SQL bị sai, không có trường SUPPLIER.
Em hỏi riêng anh 1 chút là anh có mẹo nào để có thể nhớ các lệnh để kết nối tới từng loại cơ sở dữ liệu không ạ! Quả thật em nhìn vào như mớ bòng bong luôn.
Trong link ở bài đó có nói ADO sẽ tìm 8 dòng đầu tiên, nếu tất cả là số thì nếu IMEX=1 cũng không convert từ số sang text.
Có thể chơi xấu bằng cách dùng HDR=No và IMEX = 1 nhưng không hay lắm.
