Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
[Hàm] Tách file và đặt tên theo ý muốn
#1
Rainbow 
Em chào các bác.
Em đang tổng hợp dữ liệu chuyển hàng cho các đơn vị.
Em có 1 bảng tên "ban hang" có 5 trường dữ liệu trong đó có 1 trường em để là "TINH" (Tỉnh). Em muốn xuất tự động mỗi tỉnh thành các file với tên có định dạng "teeb tỉnh + nội dung mong muốn"
Tuy nhiên khi chạy xong thì có 2 vấn đề:
1. Thiếu tiêu đề file
2. Không đặt được tên file theo ý muốn (cơ bản code chỉ xuất ra tên tỉnh như Hà Nội, Hải Phòng...) => Mất công sửa tên file. (lý do: chưa biết cách code thế nào)
Nhờ các bác tư vấn thêm giúp em.
Em cám ơn!

Lưu ý: Dữ liệu tổng cả năm sẽ lớn hơn 65K dòng nên code e để xuất ra dạng *.xlsx

Option Compare Database
Option Explicit
Private Sub Command2_Click()
    Dim db As DAO.Database
    Dim rs, rs1 As DAO.Recordset
    Dim objExcelApp, wb As Object
    Dim myPath, strTinh As String
    Dim varReturn As Variant
    DoCmd.Hourglass True
    Set objExcelApp = CreateObject("Excel.Application")
    myPath = Access.CurrentProject.Path
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT DISTINCT TINH FROM [Ban hang]", dbOpenDynaset)
    objExcelApp.DisplayAlerts = False
    Do While Not rs.EOF
        strTinh = rs("TINH")
        varReturn = SysCmd(acSysCmdSetStatus, "----->Dang xuat du lieu cho tinh: " & strTinh)
        Set rs1 = db.OpenRecordset("SELECT * FROM [Ban hang] where TINH like'" & strTinh & "'", dbOpenDynaset)
        Set wb = objExcelApp.Workbooks.Add
        Dim ws As Object
        Set ws = wb.Sheets(1)
        ws.Cells(2, 1).copyfromrecordset rs1
        wb.SaveAs myPath & "\" & strTinh
        wb.Close
        rs.MoveNext
    Loop
    varReturn = SysCmd(acSysCmdSetStatus, " ")
    objExcelApp.DisplayAlerts = True
    Set rs = Nothing
    Set rs1 = Nothing
    Set db = Nothing
    Set objExcelApp = Nothing
    DoCmd.Hourglass False
    MsgBox "Da thuc hien xong viec xuat du lieu.", vbExclamation
End Sub
Chữ ký của teutamteu teutamteu,gia nhập Thủ Thuật Access từ 18-12 -17.
Reply
Những người đã cảm ơn
#2
Em hỏi thêm làm thế nào chèn file vào được ah, không có file ví dụ sợ mọi người không hiểu
Chữ ký của teutamteu teutamteu,gia nhập Thủ Thuật Access từ 18-12 -17.
Reply
Những người đã cảm ơn
#3
Chào bạn, bạn có thể đưa file lên 1 trang chia sẻ rồi dẫn link qua.
Xem thêm
http://thuthuataccess.com/forum/announcement-1.html
Chữ ký của Noname 020
ღღღღღTài sản của Noname (View All Items) ღღღღღ
Reply
Những người đã cảm ơn teutamteu
#4
Xem code này mà chỉnh lai


Mã PHP:
Function ExportExcel()

Dim oApp As New Excel.Application
Dim oBook 
As Excel.Workbook
Dim oSheet 
As Excel.Worksheet
    
' Tao phien lam viec Excel voi Duongdanfile
   Set oBook = oApp.Workbooks.Add   '
Neu dung file mau thi doi .Add thanh .Open(DuongdanFile)
   Set oSheet oBook.Sheets("Sheet1")        ' Neu co file mau doi ten Sheet cu the
    Dim Tenfile As String
'
    Dim DB As DAO.Database
    Dim rs1 
As DAO.Recordset
    Dim rs 
As DAO.Recordset
    
' tao recordset la Tentable
    Set rs1 = CurrentDb.OpenRecordset("SELECT * FROM tblMucLuc", dbOpenDynaset)
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblNguoigiaodich", dbOpenDynaset)
    If rs1.EOF Then Exit Function
    rs1.MoveFirst
    Do Until rs1.EOF
         ' 
Chep du lieu len Excel
        oSheet
.Range("A1") = "Tieu de trong Bao cao" "_" rs1.Fields("Noidungbaocao")
        oSheet.Range("A4").CopyFromRecordset rs         'Xuat tu cot A4 tro xuong

         Tenfile = "D:\" & rs1.Fields("TenTinh") & "_" & rs1.Fields("Noidung")
         oBook.SaveAs Tenfile, 51   '
51 la dinh dang kieu Excel *.xlsx
    rs1
.MoveNext
    Loop
' Xoa bien va giai phong bo nho
   rs1.Close
   rs.Close
   oBook.Close
   oApp.Quit

End Function 

Nhớ đăng ký thêm thư viện Excel nhé;
Lưu ý rs1 của bạn trong vòng lặp, nên set = nothing sau dòng rs.Movenext; Lý do mỗi vòng lặp sẽ làm tràn bộ nhớ Ram khi gọi truy vấn với điều kiện mới
Chữ ký của maidinhdan * Để được hỗ trợ tốt nhất, nhấn vào link dưới đây để xem.
1. [Hướng dẫn] Kiểu file gửi lên để được giúp đỡ
2. [Hướng dẫn] Nội quy diễn đàn
3. [Hướng dẫn] Cách Đưa file và hình vào diễn đàn
4.[Hướng dẫn] Để xây dựng một ứng dụng hoàn hảo và lời cảm tạ
5. Cần tìm Demo hay ứng dụng sử dụng thanh tìm kiếm phía trên cùng, bên phải của diễn đàn.
* Nếu muốn cảm ơn, hãy nhấn nút thank, không cần viết thêm bài nào nửa.



ღღღღღTài sản của maidinhdan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Noname


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  [Thủ Thuật] Lọc điều kiện theo nhiều dòng trong 1 Listbox hoặc nhiều Listbox ongke0711 14 3,365 10-12-18, 09:20 PM
Bài mới nhất: ketoan_it
  [Hàm] Chia xẻ file tùy biến ẩn mọi thứ hay một vài thành thần! NguyenDungAnh 0 231 07-10-18, 12:05 PM
Bài mới nhất: NguyenDungAnh
  Xin hỏi cách : Ép phần mềm phải dùng File có đuôi OCX cũ ledangvan 6 356 07-09-18, 10:42 AM
Bài mới nhất: ongke0711
  [Help] Kết quả tính toán theo dòng record tương ứng tvn_hut 5 595 02-06-18, 03:24 PM
Bài mới nhất: tvn_hut
  Xuất dữ liệu từ Access ra Excel theo điều kiện Minh Tiên 13 1,288 25-05-18, 07:06 PM
Bài mới nhất: ongke0711

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ơ| PMA Nha Trang| Gỗ Acrylic Không Đường Line| Phần mềm quản lý bán hàng, công nợ- tồn kho- nhà phân phối