- Tham gia
- 18/3/08
- Bài viết
- 8,311
- Được thích
- 15,874
- Giới tính
- Nam
- Nghề nghiệp
- Làm ruộng.
ADO trong Excel không hố trợ việc xoá dữ liệu.
Ưu điểm, sức mạnh và mục đích của ADO là truy xuất, lọc, truy vấn, thêm record, ... từ 1 hoặc nhiều bảng, từ nguồn nội tại hoặc nguồn khác.Xin cho hỏi, dùng ADO để xóa dữ liệu (clearcontents) của:
1) Một hoặc vài cột trong Excel
2) Một bảng hoặc nhiều bảng trong 1 sheet của Excel
3) Một sheet hoặc nhiều sheet trong Excel
Thì phải làm như thế nào?
Cám ơn rất nhiều!
ADO trong Excel không hố trợ việc xoá dữ liệu.
Function ExcelConnect(ByVal AppPath As String, ByVal ExcelFileName As String) As Boolean
On Error GoTo ErrorHandle
Dim FullPath As String, ConnString As String
FullPath = AppPath & "\" & ExcelFileName
If Val(Application.Version) < 12 Then
ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & FullPath & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
Else
ConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & FullPath & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
End If
Set ObjConnect = CreateObject("ADODB.Connection")
With ObjConnect
.Mode = 3
.ConnectionTimeout = 30
.CursorLocation = 3
.ConnectionString = ConnString
.Open
End With
ExcelConnect = True
ObjConnect.Close
Exit Function
ErrorHandle:
ExcelConnect = False
Err.Clear
End Function
Sub TongHopDuLieu()
Dim FileName As String, SheetName As String, FieldName As String, _
AppPath1 As String, AppPath2 As String, AppPath3 As String, _
AppPath4 As String, sSQL As String, _
PathArr() As Variant, FileArr() As Variant, SheetArr() As Variant, _
c As Long, r As Long, _
ObjRcs As Object
FieldName = "[MAT HANG], [GIA GOC] "
AppPath1 = ThisWorkbook.Path
AppPath2 = ThisWorkbook.Path & "\Level1"
AppPath3 = ThisWorkbook.Path & "\Level2"
AppPath4 = ThisWorkbook.Path & "\Level3"
PathArr = Array(AppPath1, AppPath2, AppPath3, AppPath4)
FileArr = Array("BLM", "BLM2", "RONP", "ROUSS")
SheetArr = Array("GOC", "GOCDDH", "ronpo,duphac,opv", "GOC RS")
With ThisWorkbook.Sheets("DanhSachTongHop")
.AutoFilterMode = False
.UsedRange.EntireRow.Hidden = False
.Cells.ClearContents
For r = 0 To UBound(SheetArr)
FileName = FileArr(r) & ".xls"
SheetName = "[" & SheetArr(r) & "$] "
If ExcelConnect(PathArr(r), FileName) = False Then
MsgBox "Không kêt nôi", vbOKOnly + vbExclamation, "Thông báo"
GoTo ExitSub
Else
sSQL = "SELECT " & FieldName & "FROM " & SheetName & "WHERE [MAT HANG] <> NULL"
Set ObjRcs = CreateObject("ADODB.Recordset")
On Error GoTo SheetFieldNameErr
ObjConnect.Open
ObjRcs.Open sSQL, ObjConnect, 0, 1, 1
If ObjRcs.EOF Then
MsgBox "Không có dieu kien này", vbOKOnly + vbInformation, "THÔNG BÁO"
GoTo ExitSub
Else
With .Range("A65536").End(xlUp)
.Offset(IIf(.Row = 1, 0, 1)).CopyFromRecordset ObjRcs
End With
End If
End If
Next
r = .Range("A65536").End(xlUp).Row
Set ComboList = .Range("A1:B" & r)
ComboList.Sort .Range("A1"), xlAscending
End With
ExitSub:
Set ObjRcs = Nothing
If Not ObjConnect Is Nothing Then
If (ObjConnect.State And adStateOpen) = adStateOpen Then ObjConnect.Close
Set ObjConnect = Nothing
End If
Exit Sub
SheetFieldNameErr:
MsgBox "Ten Sheet hoac ten Tieu de cot chua dung, xin kiem tra lai!", vbCritical, "THÔNG BÁO"
Resume ExitSub
End Sub
ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & FullPath & ";" & _
"Extended Properties=""Excel 8.0;[COLOR=#ff0000][B]HDR=Yes[/B][/COLOR];IMEX=1"";"
Trong thủ tục này:
Mã:ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & FullPath & ";" & _ "Extended Properties=""Excel 8.0;[COLOR=#ff0000][B]HDR=Yes[/B][/COLOR];IMEX=1"";"
Tôi thấy có: HDR=Yes
Theo tôi nghĩ nó là HEADER, vậy nó được dùng vào mục đích gì? Nó có phải là tiêu đề cột hay không? Khi nào thì dùng? Và dùng HDR=No sẽ như thế nào?
Tôi thấy có: HDR=Yes
Theo tôi nghĩ nó là HEADER, vậy nó được dùng vào mục đích gì? Nó có phải là tiêu đề cột hay không? Khi nào thì dùng? Và dùng HDR=No sẽ như thế nào?
HDR=Yes thì các câu lệnh truy vấn sau này anh phải gọi nó rõ ràng, còn No thì mặc định của nó tự nhận là F1 cho trường đầu tiên, F2 cho trường số 2...
Dùng No cho những dữ liệu có tên trường không rõ ràng, hoặc cho những vùng dữ liệu không có tiêu đề cột.
Có nghĩa rằng khi mình gọi từ một bảng dữ liệu, nếu chọn Yes thì nó lấy dòng đầu tiên là tiêu đề cột và không tính toán gì với tiêu đề này, còn khi là No thì nó bao gồm dòng đầu tiên và nó tự gán tiêu đề từ cột 1 là F1 cho đến cột n là Fn phải vậy không?
Ta có thể dùng phương thức khác để thay thế câu lệnh không được hổ trợ này, bạn thử xem sao nhé.Hèn chi, dùng thủ tục Delete * From ... bị báo lỗi liên tục! Thì ra nó không hỗ trợ! hic hic.
Ta có thể dùng phương thức khác để thay thế câu lệnh không được hổ trợ này, bạn thử xem sao nhé.
Dĩ nhiên là ý tôi muốn nói là dùng ADO để clearcontents bảng dữ liệu, ở đây thảo luận ADO mà, như trước kia bạn thách đố tôi vậy.Nếu trên Excel thì tôi chỉ cần dùng VBA là xong. Có chăng tôi hỏi là tìm xem có cách xóa bằng ADO thôi mà. Mục đích hỏi này là tôi dùng một chương trình đã kích hoạt và tôi không muốn mở cái file cần lấy dữ liệu hoặc xóa dữ liệu lên rồi xóa mà thông qua ADO.
Và bây giờ tôi biết ADO không thể thực thi chức năng đó nên tôi chỉ sử dụng ADO nếu tôi cần truy xuất dữ liệu mà thôi. Ngoài việc đó ra thì tôi dùng code VBA để thực thi những gì mà ADO không thể làm.
Tôi cũng mới tập tành ADO thôi nên còn nhiều khó khăn trong con đường học vấn này, tôi có bài đầu tay làm tại đây, nếu có góp ý xin bạn hướng dẫn thêm cho tôi nên và không nên làm gì ở bài có đường link dưới này nhé. Cám ơn bạn rất nhiều!
http://www.giaiphapexcel.com/forum/showthread.php?69630-Th%E1%BA%A3o-lu%E1%BA%ADn-v%E1%BB%81-b%C3%A0i-ADO-c%C4%83n-b%E1%BA%A3n-K%E1%BA%BFt-n%E1%BB%91i-truy-v%E1%BA%A5n-CSDL-t%E1%BB%AB-file-Excel-%C4%91%E1%BA%BFn-file-Access&p=452144#post452144
Dĩ nhiên là ý tôi muốn nói là dùng ADO để clearcontents bảng dữ liệu, ở đây thảo luận ADO mà, như trước kia bạn thách đố tôi vậy.
Bạn nói luận điệu là sao? Bài bạn hỏi ADO có cách nào xóa bảng giống như clearcontents không? Tôi trả lời là có, là người lớn và biết suy nghĩ thì bạn đừng phát biểu với tôi như thế.Tôi tưởng bạn hướng dẫn, giúp đỡ, hoàn thiện cái bài đó cho tôi thì tôi cám ơn, chứ trả lời kiểu này tôi chẳng biết phải cám ơn bạn thế nào đây nữa???!!!
Nếu không có vấn đề gì thì đừng đưa ra những luận điệu như cái nick của bạn nhé!
Bạn nói luận điệu là sao? Bài bạn hỏi ADO có cách nào xóa bảng giống như clearcontents không? Tôi trả lời là có, là người lớn và biết suy nghĩ thì bạn đừng phát biểu với tôi như thế.
Tôi tưởng bạn hướng dẫn, giúp đỡ, hoàn thiện cái bài đó cho tôi thì tôi cám ơn, chứ trả lời kiểu này tôi chẳng biết phải cám ơn bạn thế nào đây nữa???!!!
Nếu không có vấn đề gì thì đừng đưa ra những luận điệu như cái nick của bạn nhé!
sì pam. sì pam.
Nếu anh Chàng Ngốc mà xóa được thì câu của anh Nghĩa phải sửa sao đây?![]()
Xin cho hỏi, dùng ADO để xóa dữ liệu (clearcontents) của:
1) Một hoặc vài cột trong Excel
2) Một bảng hoặc nhiều bảng trong 1 sheet của Excel
3) Một sheet hoặc nhiều sheet trong Excel
Thì phải làm như thế nào?
Cám ơn rất nhiều!
Nếu bạn thật sự có những phương thức về xóa dữ liệu trong Excel bằng ADO thì bạn dạy cho tôi đi, chứ đừng hỏi những câu cắc cớ khiến một người mới biết về ADO như tôi không biết đường đâu trả lời.
Vấn đề "thách đố" nghe hơi quá, nhưng dễ để trả lời nếu là tôi thì tôi nói "Tôi không biết" hoặc "Theo kiến thức của tôi, tôi cho rằng nó không hỗ trợ hành động đó". Đơn giản vậy thôi.
Nhưng tôi sẽ thật sự ghi nhận và trân trọng cột mốc sự việc bạn hướng dẫn này trên con đường học ADO đó bạn.
P/S: Xin được phép mượn file dữ liệu của chị HYen17
Tôi không dám dạy ai, bạn quá lời rồi, ngốc như tôi chỉ làm được như sau:
Mã:Sub XoaBang() On Error GoTo Handle Dim cnn As Object, lsSQL As String, lrs As Object Set cnn = CreateObject("ADODB.Connection") Set lrs = CreateObject("ADODB.Recordset") With cnn .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & ThisWorkbook.FullName & _ ";Extended Properties=""Excel 8.0;HDR=Yes;"";" .Open End With lsSQL = "UPDATE [ChiFi$] " & _ "set NoiDi='', DienGiai='',NTT=''" lrs.Open lsSQL, cnn, 3, 1 Set lrs = Nothing cnn.Close: Set cnn = Nothing Exit Sub Handle: MsgBox Err.Description End Sub
*/ Áp dụng cho bài trên bạn hãy xóa sheet Data thử nhé.
P/S: Xin được phép mượn file dữ liệu của chị HYen17
Hèn chi, dùng thủ tục Delete * From ... bị báo lỗi liên tục! Thì ra nó không hỗ trợ! hic hic.
Bạn đừng quên là còn 1 bài tập để áp dụng cho bài toán này nhen bạn.Mặc dù không như ý tôi muốn học hỏi:
Tuy nhiên tôi rất trân trọng những gì bạn đã giới thiệu cho tôi cái cách gọi là "cái khó ló cái khôn". Cám ơn bạn rất nhiều!
Bạn đừng quên là còn 1 bài tập để áp dụng cho bài toán này nhen bạn.
Dĩ nhiên thế, câu này giống như clearcontentsKhông hiểu tôi phát biểu như vầy có đúng không, khi ta chọn một điều kiện nào đó rồi xóa (delete) thì những dòng còn lại tự chuyển lên, giống như ta delete hàng trong excel, nhưng khi ta update "trắng" này thì những hàng rỗng đó còn nguyên, có đúng không ạ?
Dĩ nhiên thế, câu này giống như clearcontents
Tôi nghĩ bạn dư sức để giải quyết vần đề này. Dĩ nhiên là vẫn dùng theo cách trên + thêm 1 bước nữa là sắp xếp lại csdl là được. Chịu khó đi đường vòng vậy.Đúng rồi, clearcontents có thể được dùng trong Access không bạn? Tại tôi hỏi lúc đó là đang học môi trường Access nên hỏi là vậy, vì khi ta đặt con trỏ vào tiêu đề hàng của Excel và bấm nút Delete thì nó chỉ ClearContents, còn với Access thì nó Delete đi một hàng. Cái tôi có lẽ cần thật sự là như trong Access vậy đó bạn, đã là cơ sở dữ liệu thì đâu có chuyện trống hàng này có hàng kia phải không bạn?
Tôi nghĩ bạn dư sức để giải quyết vần đề này. Dĩ nhiên là vẫn dùng theo cách trên + thêm 1 bước nữa là sắp xếp lại csdl là được. Chịu khó đi đường vòng vậy.
Vấn đề là tôi muốn nói cho bạn biết, ADO cũng đa dạng chứ không phải như bạn nói nó chỉ đơn thuần là truy vấn, trích lọc dữ liệu. Còn về việc áp dụng vào thực tế thì tùy vào trường hợp mà ta chọn cách nào cho nó tối ưu. Bạn nói cố ép "heo kéo xe" sao bạn lại cố viết hàm max?Vậy vòng là vòng làm sao bạn? Chẳng lẽ tôi lại copy nguyên cái CSDL tôi lại cho nó Sort bằng lệnh ORDER BY rồi sau đó tôi lại xóa "trắng" lần nữa toàn bộ và tôi lại gán nó vào hay sao?
Hỏi vậy thôi, chứ tôi biết cố ép "heo kéo xe" cũng không hiệu quả đâu, nội việc update "trắng" thôi tôi đã thấy nó chậm quá rồi, cho nên như tôi đã nói, chỉ dùng nó khi truy xuất dữ liệu là tuyệt vời thôi, ngoài ra nó không thích hợp làm việc khác đâu.
Cám ơn bạn đã cất công hướng dẫn cho tôi.
Cái này bạn đừng vội kết luận, ADO sẽ làm nhiều điều hơn bạn tưởng đấy. Mình không dám nói mình hiểu hết cái này nhưng nếu biết áp dụng nó là công cụ cho bạn đi kiếm tiền đó bạn.chỉ dùng nó khi truy xuất dữ liệu là tuyệt vời thôi, ngoài ra nó không thích hợp làm việc khác đâu.
Vấn đề là tối muốn nói cho bạn biết, ADO cũng đa dạng chứ không phải như bạn nói nó chỉ đơn thuần là truy vấn, trích lọc dữ liệu. Còn về việc áp dụng vào thực tế thì tùy vào trường hợp mà ta chọn cách nào cho nó tồi ưu. Bạn nói cố ép "heo kéo xe" sao bạn lại cố viết hàm max?
Bạn nói:
Cái này bạn đừng vội kết luận, ADO sẽ làm nhiều điều hơn bạn tưởng đấy. Mình không dám nói mình hiểu hết cái này nhưng nếu biết áp dụng nó là công cụ cho bạn đi kiếm tiền đó bạn.
Còn cái này rõ ràng là không cải tiến được gì tốc độ được rồi vì câu lệnh SQL nó bất di bất dịch như thế rồi nên đành phải chịu thôi bạn ạ.
Câu màu đỏ là đương nhiên rồi bạn, "nhất nghệ tinh, nhất thân vinh" mà, dù là làm vệ sinh hay nhà bác học, nếu chuyên tâm yêu thích công việc của mình thì ai cũng có thể hái ra tiền bằng nghiệp vụ của mình cả.
Không hiểu tôi phát biểu như vầy có đúng không, khi ta chọn một điều kiện nào đó rồi xóa (delete) thì những dòng còn lại tự chuyển lên, giống như ta delete hàng trong excel, nhưng khi ta update "trắng" này thì những hàng rỗng đó còn nguyên, có đúng không ạ?
Chào các Pro
mình hiện tại có 2 file Excel và Access muốn liên kế dữ liệu qua lại với nhau nhưng chua biết cách viết hàm qua lại nên nhờ các Pro giúp mình với nhé
1- ở file Excel có 2 nút lệnh
nút 1 thì dùng để update dữ liệu từ Access qua Excel
Nút 2 thì dùng để update dữ liệu từ Excel qua Access
2- ở file Access cũng có 2 lệnh tương tự.
mình mới tập sự loay hoay mãi mà chưa được nên qua đây nhờ các Pro chỉ bảo giúp!
thanks!
Chào các Pro
mình hiện tại có 2 file Excel và Access muốn liên kế dữ liệu qua lại với nhau nhưng chua biết cách viết hàm qua lại nên nhờ các Pro giúp mình với nhé
1- ở file Excel có 2 nút lệnh
nút 1 thì dùng để update dữ liệu từ Access qua Excel
Nút 2 thì dùng để update dữ liệu từ Excel qua Access
2- ở file Access cũng có 2 lệnh tương tự.
mình mới tập sự loay hoay mãi mà chưa được nên qua đây nhờ các Pro chỉ bảo giúp!
thanks!
Cảm ơn bạn đã giúp mình nhé thực sự mình rất gà về vấn đề này bạn có thể giúp luôn mình không để mình học theo cách viết của bạn để học hỏi thêm chứ bảo mình nghiên cứu chắc còn khuya mới ra!
thật sự cảm ơn bạn!
Private Sub cmdLayDuLieu_Click()
With DoCmd
.SetWarnings (False)
.RunSQL "Delete * from [TB hang hoa]"
.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _
"TB hang hoa", CurrentProject.Path & "\Vi du.xls", True, "B4:G18"
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
End Sub
Private Sub cmdCapNhat_Click()
With DoCmd
.SetWarnings (False)
sSQL = "UPDATE [TB hang hoa] b " _
& "RIGHT JOIN " _
& "[Excel 8.0;HDR=YES;IMEX=2;DATABASE=" & CurrentProject.Path & "\Vi du.xls].[Sheet1$B4:G18] a " _
& "ON a.Mahang=b.Mahang " _
& "SET b.ngay=a.ngay,b.Mahang=a.Mahang,b.tenhang=a.tenhang," _
& "b.makholuutru=a.makholuutru,b.tenkholuutru=a.tenkholuutru," _
& "b.Soluongban=a.Soluongban " _
& "where a.mahang is not null"
.RunSQL sSQL
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
End Sub
Provider=Microsoft.ACE.OLEDB.12.0;
Data Source=DuongDanDenFileAcc\TenfileAccess.accdb;
Tình hình là thế này
mình có 1 file access và 1 file excel liên kết qua lại nhưng vì một số lý do nào đó mình cần báo cáo đi bằng file excel nên phải lấy dữ liệu qua excel để báo cáo nhưng mổi lần lấy rất cực.
mình muốn khi báo cáo đi mình chỉ việc thực hiện gỏ ngày cần tìm thì tự đọng nó sẽ lọc giúp mình số lượng thống kê xuất nhận tồn của những ngày đó. mình vào đây nhờ các pro chỉ giáo hộ mình
chi tiết cụ thể trong file dính kèm mình có minh họa!
Ý mình là thế này
mình muốn lọc dữ liêu từ trong 2 table
để lấy kết quả báo cáo xuất nhập tồn báo đi
bằng excel
bạn có thể giúp mình không?
Tình hình là file mình làm như thế này vì chưa hiểu rõ nên làm hơi dài dòng bạn xem hộ mình nhé!
Mình muốn lấy ra excel cũng như báo cáo trong access đó như file đầu mình có minh họa đó!
DoCmd.OutputTo acOutputReport, "R02-Currentstock", acFormatXLS, "C:\1.xls", -1
Thì bạn cứ thay đổi đường dẫn đến file đó là được.bạn hai lúa miền tây ơi cho hỏi cái!
nếu mình muốn lấy dữ liệu từ thư mục khác thì mình viết như thế nào?
Mình làm thử rồi nhưng không đc nên mới lên đây hỏi lại bạn mong bạn chỉ giúp hộ mình!
Làm cho bạn cái dialog mở theo ý muốn.ví dụ file này ở 2 thư mục khác nhau mình muốn lấy dữ liệu qua lại thì mình cần làm như thế nào?
file đính kèm bạn xem nhé!
Option Compare Database
Private Sub cmdCapNhat_Click()
Dim fd As Object, strFileName As String
Set fd = CreateObject("MSComDlg.CommonDialog")
With fd
.ShowOpen
If Len(.FileName) > 0 Then
strFileName = .FileName
Else
Exit Sub
End If
End With
With DoCmd
.SetWarnings (False)
sSQL = "UPDATE [TB hang hoa] b " _
& "RIGHT JOIN " _
& "[Excel 8.0;HDR=YES;IMEX=2;DATABASE=" & strFileName & "].[Sheet1$B4:G18] a " _
& "ON a.Mahang=b.Mahang " _
& "SET b.ngay=a.ngay,b.Mahang=a.Mahang,b.tenhang=a.tenhang," _
& "b.makholuutru=a.makholuutru,b.tenkholuutru=a.tenkholuutru," _
& "b.Soluongban=a.Soluongban " _
& "where a.mahang is not null"
DoCmd.RunSQL sSQL
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
Set fd = Nothing
End Sub
Private Sub cmdLayDuLieu_Click()
Dim fd As Object, strFileName As String
Set fd = CreateObject("MSComDlg.CommonDialog")
With fd
.ShowOpen
If Len(.FileName) > 0 Then
strFileName = .FileName
Else
Exit Sub
End If
End With
With DoCmd
.SetWarnings (False)
.RunSQL "Delete * from [TB hang hoa]"
.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _
"TB hang hoa", strFileName, True, "B4:G18"
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
Set fd = Nothing
End Sub
Sub HLMT_Update()
On Error GoTo loi
Set Cn = CreateObject("ADODB.Connection")
Dim mySQL As String
Dim fd As Object, strFileName As String
Set fd = CreateObject("MSComDlg.CommonDialog")
With fd
.ShowOpen
If Len(.Filename) > 0 Then
strFileName = .Filename
Else
Exit Sub
End If
End With
With Cn
mySQL = "UPDATE [TB hang hoa] b " _
& "right JOIN " _
& "[Excel 8.0;HDR=Yes;IMEX=2;DATABASE=" _
& ThisWorkbook.FullName & "].[Sheet1$B4:G600] a " _
& "ON b.Mahang=a.Mahang " _
& "SET b.ngay=a.ngay,b.Mahang=a.Mahang,b.tenhang=a.tenhang," _
& "b.makholuutru=a.makholuutru,b.tenkholuutru=a.tenkholuutru," _
& "b.Soluongban=a.Soluongban " _
& "where a.mahang 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
Set fd = Nothing
Exit Sub
loi:
MsgBox Err.Description
End Sub
Sub HLMT_LayDuLieu()
Dim cnn As Object, rst As Object, strCNString As String, lsSQL As String
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
Dim fd As Object, strFileName As String
Set fd = CreateObject("MSComDlg.CommonDialog")
With fd
.ShowOpen
If Len(.Filename) > 0 Then
strFileName = .Filename
Else
Exit Sub
End If
End With
strCNString = "Data Source=" & strFileName
On Error GoTo loi
With cnn
.Provider = "Microsoft Jet 4.0 OLE DB Provider"
.ConnectionString = strCNString
.CursorLocation = adUseClient
.Open
End With
lsSQL = "SELECT * " & _
"FROM [TB hang hoa]"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
Range("B5:G6000").ClearContents
Range("B5").CopyFromRecordset rst
rst.Close: cnn.Close
Set rst = Nothing: Set cnn = Nothing
Set fd = Nothing
Exit Sub
loi:
MsgBox Err.Description
End Sub
Sub HLMT_Update()
On Error GoTo loi
Set Cn = CreateObject("ADODB.Connection")
Dim mySQL As String
Dim strFileName
strFileName = Application.GetOpenFilename()
With Cn
mySQL = "UPDATE [TB hang hoa] b " _
& "right JOIN " _
& "[Excel 8.0;HDR=Yes;IMEX=2;DATABASE=" _
& ThisWorkbook.FullName & "].[Sheet1$B4:G600] a " _
& "ON b.Mahang=a.Mahang " _
& "SET b.ngay=a.ngay,b.Mahang=a.Mahang,b.tenhang=a.tenhang," _
& "b.makholuutru=a.makholuutru,b.tenkholuutru=a.tenkholuutru," _
& "b.Soluongban=a.Soluongban " _
& "where a.mahang 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
Sub HLMT_LayDuLieu()
Dim cnn As Object, rst As Object, strCNString As String, lsSQL As String
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
Dim strFileName
strFileName = Application.GetOpenFilename()
strCNString = "Data Source=" & strFileName
On Error GoTo loi
With cnn
.Provider = "Microsoft Jet 4.0 OLE DB Provider"
.ConnectionString = strCNString
.CursorLocation = adUseClient
.Open
End With
lsSQL = "SELECT * " & _
"FROM [TB hang hoa]"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
Range("B5:G6000").ClearContents
Range("B5").CopyFromRecordset rst
rst.Close: cnn.Close
Set rst = Nothing: Set cnn = Nothing
Exit Sub
loi:
MsgBox Err.Description
End Sub
trong access cũng bị lổi thì sao bạn
mình test ok rồi bạn à!
tiện thể cho mình hỏi luôn, nếu mình muốn chỉ định thư mục mặc định ở một ổ đỉa bất kỳ thì mình làm như thế nào?
vì công việc của mình là lấy dữ liệu ở rất nhiều mấy khác nhau nên mình muốn làm mặc định cho tiện!
còn phần access thì bạn giúp mình luôn, nếu thư mục có khoảng cách thì nó có hiểu không bạn?
Bạn xem file đính kèm nhé, về code ngắn hơn thì mình chưa nghĩ ra, bạn tạm dùng thế nhé.thì file lúc nảy mình có ví ** đó bạn bạn làm hộ mình để mình học hỏi!
thông cảm mình hơi gà! trong sub HLMT_Update nếu dữ liệu có rất nhiều cột thì làm theo bạn thì hơi dài dòng bạn có cách nào ngắn gọn hơn không?
còn cái tạo đường dẩn cố định tới file muốn lấy dữ liệu thì sao bạn?
ví dụ: trong 2 folder1 và 2 nằm tại ổ D:\folder1\vidu.xls
Mình sẽ làm thử nhưng bạn làm hộ mình để mình đối chiếu coi mình sai chổ nào nhé!
sao mình làm không đc bạn ơi bạn làm hộ mình với!
Option Compare Database
Private Sub cmdCapNhat_Click()
Dim strFileName As String
strFileName = "D:\folder1\vidu.xls"
With DoCmd
.SetWarnings (False)
sSQL = "UPDATE [TB hang hoa] b " _
& "RIGHT JOIN " _
& "[Excel 8.0;HDR=YES;IMEX=2;DATABASE=" & strFileName & "].[Sheet1$B4:G18] a " _
& "ON a.Mahang=b.Mahang " _
& "SET b.ngay=a.ngay,b.Mahang=a.Mahang,b.tenhang=a.tenhang," _
& "b.makholuutru=a.makholuutru,b.tenkholuutru=a.tenkholuutru," _
& "b.Soluongban=a.Soluongban " _
& "where a.mahang is not null"
DoCmd.RunSQL sSQL
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
End Sub
Private Sub cmdLayDuLieu_Click()
Dim strFileName As String
strFileName = "D:\folder1\vidu.xls"
With DoCmd
.SetWarnings (False)
.RunSQL "Delete * from [TB hang hoa]"
.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _
"TB hang hoa", strFileName, True, "B4:G18"
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
End Sub
Private Sub cmdCapNhat_Click()
Dim strFileName As String
strFileName = "D:\HocAccess\Folder02\vidu.xls"
With DoCmd
.SetWarnings (False)
sSQL = "UPDATE [TB hang hoa] b " _
& "RIGHT JOIN " _
& "[Excel 8.0;HDR=YES;IMEX=2;DATABASE=" & strFileName & "].[Sheet1$B4:G18] a " _
& "ON a.Mahang=b.Mahang " _
& "SET b.ngay=a.ngay,b.Mahang=a.Mahang,b.tenhang=a.tenhang," _
& "b.makholuutru=a.makholuutru,b.tenkholuutru=a.tenkholuutru," _
& "b.Soluongban=a.Soluongban " _
& "where a.mahang is not null"
[COLOR=#ff0000]DoCmd.RunSQL sSQL lổi đầu tiên[/COLOR]
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
End Sub
Private Sub cmdLayDuLieu_Click()
Dim strFileName As String
strFileName = "D:\HocAccess\Folder02\vidu.xls"
With DoCmd
.SetWarnings (False)
.RunSQL "Delete * from [TB hang hoa]"
[COLOR=#ff0000].TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _
"TB hang hoa", strFileName, True, "B4:G18"[/COLOR] lổi thứ 2
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
End Sub
nó báo lổi không đc bạn à
Private Sub cmdCapNhat_Click()
Dim strFileName As String
strFileName = "D:\HocAccess\Folder02\vidu.xls"
With DoCmd
.SetWarnings (False)
sSQL = "UPDATE [TB hang hoa] b " _
& "RIGHT JOIN " _
& "[Excel 8.0;HDR=YES;IMEX=2;DATABASE=" & strFileName & "].[Sheet1$B4:G18] a " _
& "ON a.Mahang=b.Mahang " _
& "SET b.ngay=a.ngay,b.Mahang=a.Mahang,b.tenhang=a.tenhang," _
& "b.makholuutru=a.makholuutru,b.tenkholuutru=a.tenkholuutru," _
& "b.Soluongban=a.Soluongban " _
& "where a.mahang is not null"
DoCmd.RunSQL sSQL lổi đầu tiên
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
End Sub
Private Sub cmdLayDuLieu_Click()
Dim strFileName As String
strFileName = "D:\HocAccess\Folder02\vidu.xls"
With DoCmd
.SetWarnings (False)
.RunSQL "Delete * from [TB hang hoa]"
.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _
"TB hang hoa", strFileName, True, "B4:G18" lổi thứ 2
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
End Sub
Vấn đề chắc chắn là do đường dẫn của bạn.bạn a mình có sưa lại thư mục cho phù hợp mà vẩn báo lổi bạn à
bạn thử tạo vào file và gửi lên mình download về thử xem!
Option Compare Database
Private Sub cmdCapNhat_Click()
Dim strFileName As String
strFileName = [B][COLOR=#0000ff]"D:\HocAccess\Folder 02\vi du.xls"[/COLOR][/B]
With DoCmd
.SetWarnings (False)
sSQL = "UPDATE [TB hang hoa] b " _
& "RIGHT JOIN " _
& "[Excel 8.0;HDR=YES;IMEX=2;DATABASE=" & strFileName & "].[Sheet1$B4:G18] a " _
& "ON a.Mahang=b.Mahang " _
& "SET b.ngay=a.ngay,b.Mahang=a.Mahang,b.tenhang=a.tenhang," _
& "b.makholuutru=a.makholuutru,b.tenkholuutru=a.tenkholuutru," _
& "b.Soluongban=a.Soluongban " _
& "where a.mahang is not null"
DoCmd.RunSQL sSQL
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
End Sub
Private Sub cmdLayDuLieu_Click()
Dim strFileName As String
strFileName = [B][COLOR=#0000cd]"D:\HocAccess\Folder 02\vi du.xls"[/COLOR][/B]
With DoCmd
.SetWarnings (False)
.RunSQL "Delete * from [TB hang hoa]"
.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _
"TB hang hoa", strFileName, True, "B4:G18"
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
End Sub
ồ đúng tại lổi mình không sưa đường dẩn file excel
1./ còn phần code của excel bạn làm luôn hộ mình nhé!
2./ ở nút update ra excel sao nó không chạy bạn? nó không chuyển dữ liệu qua excel mà lại lấy từ excel vào!
bạn xem lại chưa? nút update ra excel mà không cần mở file excel đó!
mình đã làm đc ở file excel rồi!còn lại file access update qua excel nữa thôi!
bạn ơi cho mình hỏi cái tại sao những ô dạng text khi mình đánh số vào thì nó lại không updete được
khi mình gỏ dạng text vào những ô trong access định dạng là text thì được
nhưng khi gỏ là số vào thì không tài nào update được!
bạn xem file minh họa nhé!
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 đó!
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
Tôi thử bình thường, không phát hiện lỗi gì cả.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!
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!
ko biết lỗi ở đâu nữa nhưng nhiều khả năng là chỗ này: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é: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
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
.ConnectionTimeout = 30
Gửi bài lắm thế làm chi ta? Gửi một nơi thôi. Vi phạm nội quy!!!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 .
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)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]
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)
Đ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)
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
.Open