Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
[Hướng dẫn] Tạo hàm để Export dữ liệu từ một table Access ra một file Excel
#1
Đã có Import thì phải có Export
Vẫn chọn Microsoft Excel 11.o Object libary
Chép hàm ExAcEx vào một modul của file Access
Mã PHP:
Function ExAcEx(tblTabName As StringstrFile As StringshSheet As StringCll As String)
    
Dim Ex As Excel.Application
    Dim fileEx 
As Workbook
    Set fileEx 
Ex.Workbooks.Open(strFile)
    
Dim Ws As Worksheet
    Set Ws 
fileEx.Worksheets(shSheet)
    
Dim ijkAs Integer
    i 
Ws.Range(Cll).Row
    n 
Ws.Range(Cll).Column
    Dim Rs 
As Recordset
    Set Rs 
CurrentDb.OpenRecordset(tblTabNamedbOpenTable)
    
Rs.Fields.Count
    
If Rs.RecordCount 0 Then
        Rs
.MoveFirst
        
Do Until Rs.EOF
            
For 0 To j 1
                Ws
.Cells(ik) = Rs.Fields(k)
            
Next
            i 
1
        Loop
    End 
If
    
Set Ex NothingRs.Close
End 
Function 

Khi cần goi hàm ExAcEx như sau
Call ExAcEx ("tblDanhsachkhachhang","D:\Excel\Danh sach khach hang.xls","Danh sach","A2")

Hàm chưa test
Chữ ký của Xuân Thanh Trăm năm trước thì ta chưa gặp
Trăm năm sau biết gặp được không?
Cuộc đời sắc sắc không không
Thì thôi ta cứ hết lòng vì nhau
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Noname , haquocquan , danhxetnghiem , ttm20062008
#2
Sau khi test thử, sửa lại hàm ExAcEx như sau :
1/ Thêm New trước Excel.Application(mở Ex trước khi mở file)
2/ Sau khi Export xong, lưu file Excel và đóng nó bằng dòng lệnh
fileEx.Save
fileEx.Close
Toàn bộ hàm được sửa lại như sau :

Mã PHP:
Function ExAcEx(tblTabName As StringstrFile As StringshSheet As StringCll As String)
    
Dim Ex As New Excel.Application
    Dim fileEx 
As Workbook
    Set fileEx 
Ex.Workbooks.Open(strFile)
    
Dim Ws As Worksheet
    Set Ws 
fileEx.Worksheets(shSheet)
    
Dim ijkAs Long
    i 
Ws.Range(Cll).Row
    n 
Ws.Range(Cll).Column
    Dim Rs 
As Recordset
    Set Rs 
CurrentDb.OpenRecordset(tblTabNamedbOpenTable)
    
Rs.Fields.Count
    
If Rs.RecordCount 0 Then
        Rs
.MoveFirst
        
Do Until Rs.EOF
            
For 0 To j 1
                Ws
.Cells(ik) = Rs.Fields(k)
            
Next
            Rs
.MoveNext
            i 
1
        Loop
    End 
If
    
fileEx.SavefileEx.CloseSet Ex NothingRs.Close
End 
Function 

Test thành công
Chữ ký của Xuân Thanh Trăm năm trước thì ta chưa gặp
Trăm năm sau biết gặp được không?
Cuộc đời sắc sắc không không
Thì thôi ta cứ hết lòng vì nhau
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn haquocquan , Noname , nhunguyet0103 , domfootwear , tvn_hut
#3
(11-06-12, 09:47 AM)Xuân Thanh Đã viết: Sau khi test thử, sửa lại hàm ExAcEx như sau :
1/ Thêm New trước Excel.Application(mở Ex trước khi mở file)
2/ Sau khi Export xong, lưu file Excel và đóng nó bằng dòng lệnh
fileEx.Save
fileEx.Close
Toàn bộ hàm được sửa lại như sau :

Mã PHP:
Function ExAcEx(tblTabName As StringstrFile As StringshSheet As StringCll As String)
    
Dim Ex As New Excel.Application
    Dim fileEx 
As Workbook
    Set fileEx 
Ex.Workbooks.Open(strFile)
    
Dim Ws As Worksheet
    Set Ws 
fileEx.Worksheets(shSheet)
    
Dim ijkAs Long
    i 
Ws.Range(Cll).Row
    n 
Ws.Range(Cll).Column
    Dim Rs 
As Recordset
    Set Rs 
CurrentDb.OpenRecordset(tblTabNamedbOpenTable)
    
Rs.Fields.Count
    
If Rs.RecordCount 0 Then
        Rs
.MoveFirst
        
Do Until Rs.EOF
            
For 0 To j 1
                Ws
.Cells(ik) = Rs.Fields(k)
            
Next
            Rs
.MoveNext
            i 
1
        Loop
    End 
If
    
fileEx.SavefileEx.CloseSet Ex NothingRs.Close
End 
Function 

Test thành công

Duyệt qua từng cell dữ liệu sẽ rất mất thời gian anh à, ta có thể dùng mãng để gán nó vào thì sẽ cải thiện tốc độ hơn anh à.
Chữ ký của domfootwear Xin chào Guest, nếu Guest biết thủ thuật nào thì nên chia sẻ cho cộng đồng nhé.
ღღღღღTài sản của domfootwear (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Xuân Thanh
#4
(07-08-12, 08:52 AM)domfootwear Đã viết: Duyệt qua từng cell dữ liệu sẽ rất mất thời gian anh à, ta có thể dùng mãng để gán nó vào thì sẽ cải thiện tốc độ hơn anh à.

Lâu lắm rồi không quay trở lại đề tài này. Đúng như domfootwear đã nói nhưng vì là bài đầu tiên nên viết cho những bạn mới quen với VBA. Với những bạn đã quen VBA và nâng cao lên thì sửa lại hàm như sau để cải thiện tốc độ

Mã PHP:
Function ExAcEx(tblTabName As StringstrFile As StringshSheet As StringCll As String)
    
Dim Ex As New Excel.Application
    Dim fileEx 
As Workbook
    Set fileEx 
Ex.Workbooks.Open(strFile)
    
Dim Ws As Worksheet
    Set Ws 
fileEx.Worksheets(shSheet)
    
Dim rs As Recordset
    Set rs 
CurrentDb.OpenRecordset(tblTabNamedbOpenTable)
    
Ws.Range(Cll).CopyFromRecordset rs
    fileEx
.SavefileEx.CloseSet Ex Nothingrs.Close
End 
Function 

Thank's domfootwear

@Dom : Hôm nào rảnh về miền Tây ăn lúa non và uống cafe nhé
Chữ ký của Xuân Thanh Trăm năm trước thì ta chưa gặp
Trăm năm sau biết gặp được không?
Cuộc đời sắc sắc không không
Thì thôi ta cứ hết lòng vì nhau
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn domfootwear
#5
Anh xuan thanh ơi cho e hỏi cái này chút ! Mình có cái file excel tên là lsgd, giờ muốn viết cái chương trình import cái file đó vào access, sau đó chỉ lấy 2 cột trong file excel, cột thứ nhất là ngày gd, cột thứ 2 là số dư cuối.

Ngày gd : thì phải hiện đầy đủ từ 1 -> cuối tháng, mặc dù trong file excel có khi không bắt đầu từ ngày 1

Số dư cuối : nếu ko có phát sinh trong ngày ( giao dịch ) thì số dư cuối của ngày đó bằng số dư đầu của ngày sau !

em đưa cho anh file excel và asscess bạn coi giúp em nha, chân thành cảm ơn !

http://www.mediafire.com/?umpnncvz7use0p4
Chữ ký của taoladarkpro Xin chào, mình là taoladarkpro, Tham gia http://thuthuataccess.com/forum từ ngày 30-08 -12.
Reply
Những người đã cảm ơn
#6
ai có file mẫu vừa export vừa import share cho mình với để nghiên cứu
Chữ ký của gioi01 Xin chào, mình là gioi01, Tham gia http://thuthuataccess.com/forum từ ngày 11-07 -13.
Reply
Những người đã cảm ơn
#7
Bị lỗi dòng màu đỏ dưới đây:

Function ExAcEx(tblTabName As String, strFile As String, shSheet As String, Cll As String)
Dim Ex As New Excel.Application
Dim fileEx As Workbook
Set fileEx = Ex.Workbooks.Open(strFile)
Dim Ws As Worksheet
Set Ws = fileEx.Worksheets(shSheet)
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset(tblTabName, dbOpenTable)
Ws.Range(Cll).CopyFromRecordset rs
fileEx.Save: fileEx.Close: Set Ex = Nothing: rs.Close
End Function

Bạn Xuân Thanh có thể gửi bản demo cho mọi người tham khảo được không?

Trân trọng!
Chữ ký của bangnguyencong Hãy chia sẻ kinh nghiệm cùng mình trên ThuThuatAccess nhé! Chúc vui vẻ rose
Reply
Những người đã cảm ơn
#8
(19-09-13, 11:42 AM)bangnguyencong Đã viết: Bị lỗi dòng màu đỏ dưới đây:

Mã PHP:
Function ExAcEx(tblTabName As StringstrFile As StringshSheet As StringCll As String)
    [
color=#FF0000]Dim Ex As New Excel.Application[/color]
    
Dim fileEx As Workbook
    Set fileEx 
Ex.Workbooks.Open(strFile)
    
Dim Ws As Worksheet
    Set Ws 
fileEx.Worksheets(shSheet)
    
Dim rs As Recordset
    Set rs 
CurrentDb.OpenRecordset(tblTabNamedbOpenTable)
    
Ws.Range(Cll).CopyFromRecordset rs
    fileEx
.SavefileEx.CloseSet Ex Nothingrs.Close
End 
Function 

Bạn Xuân Thanh có thể gửi bản demo cho mọi người tham khảo được không?

Trân trọng!

Trong cửa sổ VBE, vào Tools/Reference chọn thêm thư viện Microsoft Excel xx Object Libary. Bạn không đọc kỹ bài #1
Thân mến
Chữ ký của Xuân Thanh Trăm năm trước thì ta chưa gặp
Trăm năm sau biết gặp được không?
Cuộc đời sắc sắc không không
Thì thôi ta cứ hết lòng vì nhau
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#9
Bác Xuân Thanh cho mình hỏi là mình cần xuất từ Query ra Excel thì như thế nào? với lại sử dụng Function như thế nào bác? mình ko rành về access lắm, bác hướng dẫn cụ thể giùm nhé, tại mình dùng form tạo nút lệnh, tạo event onclick rồi dùng câu lệnh gọi hàm như bạn mà báo lỗi ở file excel tìm không thấy?
Chữ ký của ndthanh29 Xin chào, mình là ndthanh29, Tham gia http://thuthuataccess.com/forum từ ngày 08-10 -12.
Reply
Những người đã cảm ơn
#10
Bạn xem lại câu lệnh gọi hàm tôi đã ghi ở #1

Mã PHP:
Private Sub cmdXuatEx_Click()
    
Call ExAcEx ("tblDanhsachkhachhang","D:\Excel\Danh sach khach hang.xls","Danh sach","A2")
End Sub 

Giải thích thêm
1/ tblDanhsachkhachhang : tên table chứa dữ liệu cần xuất ra Excel
2/ D:\Excel\Danh sach khach hang.xls : là tên file Excel cần xuất dữ liệu bao gồm cã đường dẫn
3/ Danh sach : tên Sheet Excel chứa dữ liệu cần xuất ra
4/ A2 : Ô đầu tiên chứa dữ liệu cần xuất ra

Muốn xuất một query thì phải viết thêm lệnh hoặc bạn Make Table Query ra một table rồi dùng lênh trên là OK

Thân mến
Chữ ký của Xuân Thanh Trăm năm trước thì ta chưa gặp
Trăm năm sau biết gặp được không?
Cuộc đời sắc sắc không không
Thì thôi ta cứ hết lòng vì nhau
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Che_Guevara


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  Cài đặt ODBC -nền tảng kết nối Access và nguồn dữ liệu khác Noname 33 19,325 01-12-16, 06:49 PM
Bài mới nhất: atula77
  Xây dựng Class Modules trong Access ( Cơ bản đến Nâng cao) maidinhdan 2 188 13-11-16, 05:32 PM
Bài mới nhất: cpucloi
  Hướng Dẫn Demo tổng hợp xuất Table, Query sang Excel có điều kiện ở vị trí nào cũng được maidinhdan 18 2,795 20-10-16, 11:51 AM
Bài mới nhất: jeck09nt
  Ms Access VBA và Google drive, một vài ý tưởng trong chia sẻ và đồng bộ số liệu... paulsteigel 46 3,862 07-10-16, 02:43 PM
Bài mới nhất: kieu manh
  Ứng dụng đổi tên file trong windows hàng loạt tranthanhan1962 7 1,213 19-09-16, 04:16 PM
Bài mới nhất: maidinhdan

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ