Tách file và đặt tên theo ý muốn
teutamteu > 18-12-17, 04:56 PM
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