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."

Blue Softs epl Liên hệ QC

huyhoang_mmyeht

Thành viên hoạt động
Tham gia
5/5/09
Bài viết
115
Được thích
2
cái đó mình làm rồi được nhưng đây là mình lấy dữ liệu của người khác nên không thể vào đó định dạng lại rồi mới update được hơn nữa mình muốn có cách nào khi update thì nó tự hiểu không bạn! và các cột khác cũng vậy không riêng gì 2 cột đó!
 

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆
Thành viên BQT
Administrator
Tham gia
18/3/08
Bài viết
8,145
Được thích
15,461
Giới tính
Nam
Nghề nghiệp
Làm ruộng.
cái đó mình làm rồi được nhưng đây là mình lấy dữ liệu của người khác nên không thể vào đó định dạng lại rồi mới update được hơn nữa mình muốn có cách nào khi update thì nó tự hiểu không bạn! và các cột khác cũng vậy không riêng gì 2 cột đó!

Bạn chưa thử bài 179 tôi đã làm cho bạn rồi.

Mã:
Sub HLMT_Update()
    On Error GoTo loi
    Set Cn = CreateObject("ADODB.Connection")
    Dim mySQL As String
    Dim strFileName
    strFileName = "C:\DATA\DATA.MDB"
     With Cn
        mySQL = "UPDATE [THDS] b " _
              & "right JOIN " _
              & "[Excel 8.0;HDR=Yes;[B][COLOR=#ff0000]IMEX=1[/COLOR][/B];DATABASE=" _
              & ThisWorkbook.FullName & "].[Sheet1$B4:BO600] a  " _
              & "ON b.D15=a.D15 " _
              & "SET b.D01=a.D01,b.D02=a.D02,b.D03=a.D03,b.D04=a.D04,b.D05=a.D05,b.D06=a.D06,b.D07=a.D07,b.D08=a.D08," _
              & "b.D09=a.D09,b.D10=a.D10,b.D11=a.D11,b.D12=a.D12,b.D13=a.D13,b.D14=a.D14,b.D15=a.D15,b.D16=a.D16," _
              & "b.D17=a.D17,b.D18=a.D18,b.D19=a.D19,b.D20=a.D20,b.D21=a.D21,b.D22=a.D22,b.D23=a.D23,b.D24=a.D24," _
              & "b.D25=a.D25,b.D26=a.D26,b.D27=a.D27,b.D28=a.D28,b.D29=a.D29,b.C07=a.C07,b.C08=a.C08,b.C09=a.C09," _
              & "b.C18=a.C18,b.C19=a.C19,b.C20=a.C20,b.C21=a.C21,b.C22=a.C22,b.C23=a.C23,b.C24=a.C24,b.C25=a.C25," _
              & "b.C28=a.C28,b.C29=a.C29,b.C30=a.C30,b.C31=a.C31,b.C32=a.C32,b.C33=a.C33,b.C34=a.C34,b.C35=a.C35," _
              & "b.C36=a.C36,b.C37=a.C37,b.D100=a.D100,b.D101=a.D101,b.D102=a.D102,b.D103=a.D103,b.D104=a.D104," _
              & "b.D105=a.D105 " _
              & "where a.D15 is not null"
        .Provider = "Microsoft Jet 4.0 OLE DB Provider"
        .ConnectionString = "Data Source=" & strFileName
        .CursorLocation = adUseClient
        .Open
        .Execute mySQL
        .Close
    End With
    Set Cn = Nothing
    Exit Sub
loi:
    MsgBox Err.Description

End Sub
 

huyhoang_mmyeht

Thành viên hoạt động
Tham gia
5/5/09
Bài viết
115
Được thích
2
vẩn còn vấn đề nhỏ này nữa bạn à! nếu khi mình gõ dữ liệu vào cột P(D15)"đây là khóa chính trong access" mà là số thì khi update nó báo lỗi type mismatch in expression còn lại mình gỏ là text thì không sao!
 

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆
Thành viên BQT
Administrator
Tham gia
18/3/08
Bài viết
8,145
Được thích
15,461
Giới tính
Nam
Nghề nghiệp
Làm ruộng.
vẩn còn vấn đề nhỏ này nữa bạn à! nếu khi mình gõ dữ liệu vào cột P(D15)"đây là khóa chính trong access" mà là số thì khi update nó báo lỗi type mismatch in expression còn lại mình gỏ là text thì không sao!
Tôi thử bình thường, không phát hiện lỗi gì cả.
 

huyhoang_mmyeht

Thành viên hoạt động
Tham gia
5/5/09
Bài viết
115
Được thích
2
bạn định dạng lại dạng số sau đó sửa dấu ' ở đầu rồi chạy thử xem!
 

huyhoang_mmyeht

Thành viên hoạt động
Tham gia
5/5/09
Bài viết
115
Được thích
2
Bạn xem nhé! nó báo lỗi mình đã sữa lại theo bạn mà vẩn vậy!
 

File đính kèm

  • THDH.zip
    74 KB · Đọc: 29

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆
Thành viên BQT
Administrator
Tham gia
18/3/08
Bài viết
8,145
Được thích
15,461
Giới tính
Nam
Nghề nghiệp
Làm ruộng.
Bạn xem nhé! nó báo lỗi mình đã sữa lại theo bạn mà vẩn vậy!

Thôi thì để cho tiện và khớp với dữ liệu của bạn, bạn phải quy định người nhập liệu nhập như thế nào cho trùng khớp với kiểu dữ liệu, còn không khớp thì bạn sẽ bị "réo" dài dài...
 

phuongtrannhat1409

Thành viên mới
Tham gia
17/12/12
Bài viết
41
Được thích
14
Nghề nghiệp
Kế toán
Anh HLMT cho em hỏi lổi Run-time '3706': Provider cannot be found. If may not be properly installed. Em gặp lổi này khi chuyển qua sử dụng win 10 (64) và office 2016 (64)

Đoạn code bị lổi đây ạ:

Sub KetNoi()
'On Error Resume Next
FName = ThisWorkbook.Path & "" & ThisWorkbook.Name
Set Cnex = New ADODB.Connection
'Khai bao cau ket noi
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
FName & ";Persist Security Info=False; Extended Properties=Excel 8.0;"
Cnex.Open ConnectionString
Set Recex = New ADODB.Recordset
End Sub
 

quanluu

Thành viên gắn bó
Tham gia
11/4/13
Bài viết
2,150
Được thích
1,255
Anh HLMT cho em hỏi lổi Run-time '3706': Provider cannot be found. If may not be properly installed. Em gặp lổi này khi chuyển qua sử dụng win 10 (64) và office 2016 (64)

Đoạn code bị lổi đây ạ:

Sub KetNoi()
'On Error Resume Next
FName = ThisWorkbook.Path & "" & ThisWorkbook.Name
Set Cnex = New ADODB.Connection
'Khai bao cau ket noi
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
FName & ";Persist Security Info=False; Extended Properties=Excel 8.0;"
Cnex.Open ConnectionString
Set Recex = New ADODB.Recordset
End Sub
ko biết lỗi ở đâu nữa nhưng nhiều khả năng là chỗ này:
FName = ThisWorkbook.Path & "" & ThisWorkbook.Name

phải là
FName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
 

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆
Thành viên BQT
Administrator
Tham gia
18/3/08
Bài viết
8,145
Được thích
15,461
Giới tính
Nam
Nghề nghiệp
Làm ruộng.
Anh HLMT cho em hỏi lổi Run-time '3706': Provider cannot be found. If may not be properly installed. Em gặp lổi này khi chuyển qua sử dụng win 10 (64) và office 2016 (64)

Đoạn code bị lổi đây ạ:

Sub KetNoi()
'On Error Resume Next
FName = ThisWorkbook.Path & "" & ThisWorkbook.Name
Set Cnex = New ADODB.Connection
'Khai bao cau ket noi
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
FName & ";Persist Security Info=False; Extended Properties=Excel 8.0;"
Cnex.Open ConnectionString
Set Recex = New ADODB.Recordset
End Sub
Bạn giúp tôi thay cái Provider trên và test thử xem nhé:


[GPECODE=sql]Sub KetNoi()
'On Error Resume Next
FName = ThisWorkbook.Path & "\ " & TenWB
Set Cnex = New ADODB.Connection
'Khai bao cau ket noi
ConnectionString = "Provider=microsoft.ace.oledb.12.0;Data Source=" & _
FName & ";Persist Security Info=False; Extended Properties=""Excel 12.0"";"
Cnex.Open ConnectionString
Set Recex = New ADODB.Recordset
End Sub[/GPECODE]
 
Lần chỉnh sửa cuối:

phuongtrannhat1409

Thành viên mới
Tham gia
17/12/12
Bài viết
41
Được thích
14
Nghề nghiệp
Kế toán
Sửa như anh HLMT thì hết bị, cám ơn anh nhiều
 

phuongthu0109

Thành viên mới
Tham gia
3/6/15
Bài viết
22
Được thích
1
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

Bác cho em hỏi tại sao phải thử kết nối trước.
giả sử bác thử kết nối ok. đến lúc phần code kết nối thật sự để lấy dữ liệu thì kết nối này hỏng. thì bước thử kết nối trước đó có ý nghĩa gì.
và câu lệnh này có ý nghĩa gì
Mã:
.ConnectionTimeout = 30

stackoverflow.com/questions/13558921/how-can-vba-connect-to-mysql-database-in-excel
stackoverflow.com/questions/4305436/excel-vba-query-a-mysql-database

stackoverflow.com/questions/13558921/how-can-vba-connect-to-mysql-database-in-excel
stackoverflow.com/questions/25698032/select-query-run-from-vba-using-ado-recordset-object-does-not-return-a-complete
 
Lần chỉnh sửa cuối:

nghiapv084

Thành viên mới
Tham gia
24/7/14
Bài viết
46
Được thích
2
Nhờ các anh giúp đỡ cách nhập dữ liệu từ excell sang acess , Em có dùng code của anh trên GPE , mong các anh chỉ giúp .
 

File đính kèm

  • nho GPE.rar
    28.7 KB · Đọc: 11

nghiapv084

Thành viên mới
Tham gia
24/7/14
Bài viết
46
Được thích
2
sory anh , em không để ý thông báo (alerts) . vào đâu để bỏ dòng đăng em ko tìm thấy .. anh giúp em lun nhé
 

lengoc1490

Thành viên mới
Tham gia
21/8/14
Bài viết
9
Được thích
0
E đang làm quen với ADO. Nhờ các thầy cô và anh chị kiểm tra giúp e file copy dữ liệu từ nhiều sheet đang bị lỗi gì.
Cũng với code này e thử copy dữ liệu ít hơn 50 sheet thì chạy được. Nhưng nhiều hơn 50 sheet thì báo lỗi.
E cảm ơn thầy cô và anh chị nhiều ah
 

File đính kèm

  • ADO_Sheet.xlsm
    132.6 KB · Đọc: 7

khotp

Thành viên mới
Tham gia
30/10/08
Bài viết
17
Được thích
241
Bạn giúp tôi thay cái Provider trên và test thử xem nhé:


[GPECODE=sql]Sub KetNoi()
'On Error Resume Next
FName = ThisWorkbook.Path & "\ " & TenWB
Set Cnex = New ADODB.Connection
'Khai bao cau ket noi
ConnectionString = "Provider=microsoft.ace.oledb.12.0;Data Source=" & _
FName & ";Persist Security Info=False; Extended Properties=""Excel 12.0"";"
Cnex.Open ConnectionString
Set Recex = New ADODB.Recordset
End Sub[/GPECODE]
Anh HLMT cho em hỏi lổi Run-time '3706': Provider cannot be found. If may not be properly installed. Em gặp lổi này khi chuyển qua sử dụng win 10 (64) và office 2013 (64)

Đoạn code bị lổi đây Anh:


Sub Loc_HLMT()
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "SELECT F1,F2,F3,F4,F5,F6,F7,F8,F9 " & _
"FROM [DATA$A2:I5000] " & _
"WHERE F3 BETWEEN #" & Format(Sheet3.[E5].Value, "dd-MMM-yyyy") & "# AND #" & _
Format(Sheet3.[E6].Value, "dd-MMM-yyyy") & "# "
End With
With Sheet3
.[a10:I500].ClearContents
.[a10].CopyFromRecordset adoRS
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing
End Sub

Mong anh chỉ dẫn
Thanks and best regards
 

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆
Thành viên BQT
Administrator
Tham gia
18/3/08
Bài viết
8,145
Được thích
15,461
Giới tính
Nam
Nghề nghiệp
Làm ruộng.
Anh HLMT cho em hỏi lổi Run-time '3706': Provider cannot be found. If may not be properly installed. Em gặp lổi này khi chuyển qua sử dụng win 10 (64) và office 2013 (64)

Đoạn code bị lổi đây Anh:


Sub Loc_HLMT()
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "SELECT F1,F2,F3,F4,F5,F6,F7,F8,F9 " & _
"FROM [DATA$A2:I5000] " & _
"WHERE F3 BETWEEN #" & Format(Sheet3.[E5].Value, "dd-MMM-yyyy") & "# AND #" & _
Format(Sheet3.[E6].Value, "dd-MMM-yyyy") & "# "
End With
With Sheet3
.[a10:I500].ClearContents
.[a10].CopyFromRecordset adoRS
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing
End Sub

Mong anh chỉ dẫn
Thanks and best regards
Bạn tìm và cài đặt cái "Microsoft Access Database Engine" phiên bản phù hợp là được nhé bạn.
 

ongke0711

Thành viên tích cực
Tham gia
7/9/06
Bài viết
1,097
Được thích
1,314
Giới tính
Nam
Anh HLMT cho em hỏi lổi Run-time '3706': Provider cannot be found. If may not be properly installed. Em gặp lổi này khi chuyển qua sử dụng win 10 (64) và office 2013 (64)


.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
.Open

Thay đoạn này: Provider=Microsoft.ACE.OLEDB.12.0
 
Web KT
Top Bottom