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
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 đó!
 
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
 
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!
 
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ả.
 
bạn định dạng lại dạng số sau đó sửa dấu ' ở đầu rồi chạy thử xem!
 
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: 33
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...
 
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
 
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
 
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:
Sửa như anh HLMT thì hết bị, cám ơn anh nhiều
 
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:
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: 12
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é
 
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: 8
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
 
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.
 
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
Back
Top Bottom