Tạo hàm để Export dữ liệu từ table Access ra file Excel (1 người xem)

[XuanThanh]

Vẫn chọn Microsoft Excel 11.0 Object libary
Chép hàm ExAcEx vào một modul của file Access

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 i, j, k, n As Long
    i = Ws.Range(Cll).Row
    n = Ws.Range(Cll).Column
    Dim Rs As Recordset
    Set Rs = CurrentDb.OpenRecordset(tblTabName, dbOpenTable)
    j = Rs.Fields.Count
    If Rs.RecordCount > 0 Then
        Rs.MoveFirst
        Do Until Rs.EOF
            For k = 0 To j - 1
                Ws.Cells(i, n + k) = Rs.Fields(k)
            Next
            Rs.MoveNext
            i = i + 1
        Loop
    End If
    fileEx.Save: fileEx.Close: Set Ex = Nothing: Rs.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")

Test thành công, dùng cho Office 2003

 

[uronmapu]

Private Sub cmdExport_Click()

'EXPORT to EXCEL
Dim myExApp As Excel.Application    'variable for Excel App
Dim myExSheet As Excel.Worksheet    'variable for Excel Sheet
Dim i As Long                       'variable for ColumnCount
Dim j As Long                       'variable for ListCount
Set myExApp = New Excel.Application

myExApp.Visible = True              'Sets Excel visible
myExApp.Workbooks.Add               'Add a new Workbook
Set myExSheet = myExApp.Workbooks(1).Worksheets(1)

For i = 1 To lstItems.ColumnCount   'Counter for ColumnCount
    lstItems.BoundColumn = lstItems.BoundColumn + 1 'Setting counter for BoundColumn
    For j = 1 To lstItems.ListCount 'Counter for ListCount
        myExSheet.Cells(j, i) = lstItems.ItemData(j - 1)     'Insert ItemData into Excel Worksheet
    Next j  'Iterating through ListCount
Next i  'Iterating through ColumnCount
lstItems.BoundColumn = 1    'Setting BoundColumn to original 1

Set myExSheet = Nothing 'Release Worksheet
Set myExApp = Nothing   'Release Excel Application


End Sub

http://thuthuataccess.com/forum/thread-5234.html
http://thuthuataccess.com/forum/thread-3282.html
http://thuthuataccess.com/forum/thread-5182.html