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

  • Thread starter Thread starter ThuNghi
  • Ngày gửi Ngày gửi
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 đó!
 
huyhoang_mmyeht đã viế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 đó!
Nhấp chuột vào đây để mở rộng...

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!
 
huyhoang_mmyeht đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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

huyhoang_mmyeht đã viết:
Bạn xem nhé! nó báo lỗi mình đã sữa lại theo bạn mà vẩn vậy!
Nhấp chuột vào đây để mở rộng...

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
 
phuongtrannhat1409 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
phuongtrannhat1409 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
Hoàng Trọng Nghĩa đã viết:
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
Nhấp chuột vào đây để mở rộng...

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

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

Hai Lúa Miền Tây đã viết:
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]
Nhấp chuột vào đây để mở rộ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
 
khotp đã viết:
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
Nhấp chuột vào đây để mở rộng...
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.
 
khotp đã viết:
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
Nhấp chuột vào đây để mở rộng...

Thay đoạn này: Provider=Microsoft.ACE.OLEDB.12.0
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

H
Công thức tìm kết quả
Trả lời
3
Đọc
28
Hoàng Tuấn 868
H
N
Nhờ các anh chỉ chỉnh lỗi giúp em với ạ, em cảm ơn ạ.
Trả lời
3
Đọc
54
minhminh27
minhminh27
T
File quản lý thiết bị trong trường học!
Trả lời
4
Đọc
105
VetMini
V
Xoainon3005
Xin file mẫu kế hoạch sản xuất theo tháng ngành động cơ
Trả lời
1
Đọc
110
VetMini
V
Momominh
Sơ đồ hàng hóa trong Container
Trả lời
3
Đọc
97
VetMini
V
L
Viết phần mềm đánh lô bằng Visual Basic
    • Thích
2 3
Trả lời
51
Đọc
103K
taimeanh
T
hungtin1997
  • Question Question
[Hỏi] Tạo Hyperlink đến ô chạy ngang theo cột
Trả lời
6
Đọc
401
A HOANG 620
A
LuuAnh980
Add in tạo QR code miễn phí.
Trả lời
14
Đọc
533
htin1997
htin1997
tramcannt
Các bác cho hỏi làm cách nào để thu nhỏ thanh công thức này với ạ. Em cảm ơn.
Trả lời
2
Đọc
51
Nhattanktnn
Nhattanktnn
S
  • Question Question
Điều chỉnh kích thước dòng tự động theo trang in
Trả lời
5
Đọc
133
HUONGHCKT
H
A
Tạo vé Loto bằng Excel
2
Trả lời
20
Đọc
23K
Tuấn tata
Tuấn tata
Nauduong
Cách chuyển định dạng từ PDF sang Image
Trả lời
9
Đọc
250
Châu Bá Thông
Châu Bá Thông
minhduongct
  • Question Question
Viết code VBA thay cho dùng hàm vlookup
Trả lời
6
Đọc
1K
VetMini
V
N
Thử viết code lập trình đa luồng bằng TwinBasic và khả năng ứng dụng vào COM add-in chạy trong Excel
    • Thích
Trả lời
0
Đọc
134
nguyendang95
N
Thanh271188
Tìm giá trị xuất hiện bất kì (không phải giá trị đầu, cuối) trong excel
    • Cười
Trả lời
4
Đọc
219
Duy Tùng 9x
Duy Tùng 9x
H
Xin viết dùng mã vba thay thế cho hàm vlookup
    • Thích
12 13 14
Trả lời
264
Đọc
79K
VetMini
V
SA_DQ
  • Question Question
[Bài tập VBA cho người rỗi rảnh] Hãy viết 1 macro tìm ra 3 số nguyên tố liên tiếp
2
Trả lời
35
Đọc
745
VetMini
V
P
Các Bác cho e hỏi làm thế nào để ẩn công thức trên GOOGLE SHEET với ạ?
2
Trả lời
22
Đọc
18K
yeudoi
yeudoi
T
Định dạng cột dữ liệu trong sql
Trả lời
5
Đọc
134
ptm0412
ptm0412
L
  • Question Question
[Hlep] Xóa ảnh theo tên và kích thước
Trả lời
8
Đọc
197
Luong24
L
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom