tự động cập nhật excel vào access

hoabattu3387 · 26/9/17

Mình có 1 file access lấy dữ liệu từ file excel vào bảng BVL để tạo ra 2 report BVL và VTB, file excel thay đổi theo ngày (cả nội dung lẫn tên file). Nhờ các bạn viết code giúp mình trên access để tự động lấy dữ liệu từ file excel.
Mình cảm ơn cả nhà!

Hai Lúa Miền Tây · 3/10/17

hoabattu3387 đã viết:
tiêu đề cột đúng a ạ, chạy qua dòng

Mã:

Set cn = CurrentProject.Connection

thì báo lôĩ và thoát luôn access.
cái chỗ "insert in to BVL..." liệu nó có hiểu insert vào bảng BVL ko anh?

Máy tôi chạy bình thường, bạn thử chạy code này từ file Excel coi nó có bị gì không nhé

Mã:

Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\POS.accdb")
cn.Execute ("insert into BVL SELECT * FROM [Excel 12.0;HDR=YES;DATABASE=" & ThisWorkbook.FullName & "].[DetailOfCreditTotalTransaction$A6:Z100] Where MID is not null")

hoabattu3387 · 4/10/17

Hai Lúa Miền Tây đã viết:
Máy tôi chạy bình thường, bạn thử chạy code này từ file Excel coi nó có bị gì không nhé

Mã:

Dim cn As Object Set cn = CreateObject("ADODB.Connection") cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\POS.accdb") cn.Execute ("insert into BVL SELECT * FROM [Excel 12.0;HDR=YES;DATABASE=" & ThisWorkbook.FullName & "].[DetailOfCreditTotalTransaction$A6:Z100] Where MID is not null")

e chạy từ excel thì được ạ. nhưng khi e sửa code như này vào access

Mã:

Sub importfile()
Dim tblefilename, tblename As String
tblefilename = Access.CurrentProject.Path
FName = "\BVL.XLSX"
tblename = tblefilename & FName
Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & tblename)
cn.Execute ("insert into BVL SELECT * FROM [Excel 12.0;HDR=YES;DATABASE= [DetailOfCreditTotalTransaction$A6:Z100] Where MID is not null")
DoCmd.OutputTo ObjectType:=acOutputQuery, ObjectName:="chi tiet gui bvl", OutputFormat:=acFormatXLSX, Outputfile:=tblefilename & "\chi tiet gui bvl.xlsx"
DoCmd.OutputTo ObjectType:=acOutputReport, ObjectName:="BVL", OutputFormat:=acFormatPDF, Outputfile:=tblefilename & "\BVL.pdf"
DoCmd.OutputTo ObjectType:=acOutputReport, ObjectName:="VTB", OutputFormat:=acFormatPDF, Outputfile:=tblefilename & "\VTB.pdf"
End Sub

thì báo lỗi "unreconigze database fomat" từ dòng

Mã:

cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & tblename)

Hai Lúa Miền Tây · 4/10/17

hoabattu3387 đã viết:

e chạy từ excel thì được ạ. nhưng khi e sửa code như này vào access

Mã:

Sub importfile()
Dim tblefilename, tblename As String
tblefilename = Access.CurrentProject.Path
FName = "\BVL.XLSX"
tblename = tblefilename & FName
Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & tblename)
cn.Execute ("insert into BVL SELECT * FROM [Excel 12.0;HDR=YES;DATABASE= [DetailOfCreditTotalTransaction$A6:Z100] Where MID is not null")
DoCmd.OutputTo ObjectType:=acOutputQuery, ObjectName:="chi tiet gui bvl", OutputFormat:=acFormatXLSX, Outputfile:=tblefilename & "\chi tiet gui bvl.xlsx"
DoCmd.OutputTo ObjectType:=acOutputReport, ObjectName:="BVL", OutputFormat:=acFormatPDF, Outputfile:=tblefilename & "\BVL.pdf"
DoCmd.OutputTo ObjectType:=acOutputReport, ObjectName:="VTB", OutputFormat:=acFormatPDF, Outputfile:=tblefilename & "\VTB.pdf"
End Sub

thì báo lỗi "unreconigze database fomat" từ dòng

Mã:

cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & tblename)

Bạn thử test code sau:

Mã:

Private Sub Command0_Click()
    Dim tblefilename, tblename As String
    tblefilename = Access.CurrentProject.Path
    FName = "\DetailOfCreditTotalTransaction_20170926_105939.xlsx"
    tblename = tblefilename & FName
    Dim cn As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & tblefilename & "\POS.accdb")
    
    cn.Execute ("insert into [BVL] SELECT * FROM [Excel 12.0;HDR=YES;DATABASE=" & tblename & "].[DetailOfCreditTotalTransaction$A6:Z100] Where MID is not null")
    DoCmd.OutputTo ObjectType:=acOutputQuery, ObjectName:="chi tiet gui bvl", OutputFormat:=acFormatXLSX, Outputfile:=tblefilename & "\chi tiet gui bvl.xlsx"
    DoCmd.OutputTo ObjectType:=acOutputReport, ObjectName:="BVL", OutputFormat:=acFormatPDF, Outputfile:=tblefilename & "\BVL.pdf"
    DoCmd.OutputTo ObjectType:=acOutputReport, ObjectName:="VTB", OutputFormat:=acFormatPDF, Outputfile:=tblefilename & "\VTB.pdf"
End Sub

hoabattu3387 · 4/10/17

Hai Lúa Miền Tây đã viết:
Bạn thử test code sau:

Đã chạy oki rồi anh ạ. Em hỏi chút là dictionary có dùng được trong access không anh?em search google mà không thấy nói đến, em muốn query từng MiD và xuất ra các file excel 1 cách tự động (như query "chi tiet gui bvl" của em nhưng có bao nhiêu MID thì bấy nhiêu file chứ ko phải 1 file tổng hợp như hiện tại ạ)

befaint · 4/10/17

hoabattu3387 đã viết:
Em hỏi chút là dictionary có dùng được trong access không

Mình thử thì biết liền, chứ hỏi phải chờ kết quả hơi lâu...

Hai Lúa Miền Tây · 5/10/17

hoabattu3387 đã viết:
Đã chạy oki rồi anh ạ. Em hỏi chút là dictionary có dùng được trong access không anh?em search google mà không thấy nói đến, em muốn query từng MiD và xuất ra các file excel 1 cách tự động (như query "chi tiet gui bvl" của em nhưng có bao nhiêu MID thì bấy nhiêu file chứ ko phải 1 file tổng hợp như hiện tại ạ)

Có sẵn Query thì chỉ duyệt qua nó thôi, đâu cần dùng dic làm gì bạn.

hoabattu3387 · 5/10/17

Hai Lúa Miền Tây đã viết:
Có sẵn Query thì chỉ duyệt qua nó thôi, đâu cần dùng dic làm gì bạn.

A giúp em để em học tập với ạ. Em chỉ nghĩ đến dic, nhưng ở excel thì e biết làm còn access e mới học nên chưa nghĩ ra cách ạ.

Hai Lúa Miền Tây · 5/10/17

hoabattu3387 đã viết:
A giúp em để em học tập với ạ. Em chỉ nghĩ đến dic, nhưng ở excel thì e biết làm còn access e mới học nên chưa nghĩ ra cách ạ.

Tạo 1 recordset với câu truy vấn là select distinct MID..., rồi sau đó dùng vòng lặp duyệt qua từng dòng của field MID này, mỗi lần duyệt qua lấy giá trị gán vào điều kiện lọc và xuất file. LÀm như vậy sẽ gọn và linh hoạt hơn.

VetMini · 5/10/17

Các phần mềm sử dung câu truy vấn SQL query có những phép tính lọc hiệu quả hơn ta dùng Dictionary nhiều.
Lưu ý rằng lọc không trùng chỉ là một ứng dụng của Dictionary mà ở diễn đàn này sử dụng nhiều. Có vậy thôi.

hoabattu3387 · 6/10/17

Hai Lúa Miền Tây đã viết:
Tạo 1 recordset với câu truy vấn là select distinct MID..., rồi sau đó dùng vòng lặp duyệt qua từng dòng của field MID này, mỗi lần duyệt qua lấy giá trị gán vào điều kiện lọc và xuất file. LÀm như vậy sẽ gọn và linh hoạt hơn.

A kiểm tra đoạn sau của e giúp e với sao recordcount chỉ có 1 record nhỉ? em có sai chỗ nào không ạ?

Mã:

   Dim rcs As Recordset
    Dim qry As QueryDef
    Set qry = CurrentDb.QueryDefs("chi tiet gui bvl")
    Set rcs = qry.OpenRecordset
    MsgBox (rcs.RecordCount)

quanluu · 6/10/17

hoabattu3387 đã viết:
A kiểm tra đoạn sau của e giúp e với sao recordcount chỉ có 1 record nhỉ? em có sai chỗ nào không ạ?

Mã:

Dim rcs As Recordset Dim qry As QueryDef Set qry = CurrentDb.QueryDefs("chi tiet gui bvl") Set rcs = qry.OpenRecordset MsgBox (rcs.RecordCount)

Bạn thêm dòng này trước Msgbox:

rcs.MoveLast

hoabattu3387 · 9/10/17

Hai Lúa Miền Tây đã viết:
Tạo 1 recordset với câu truy vấn là select distinct MID..., rồi sau đó dùng vòng lặp duyệt qua từng dòng của field MID này, mỗi lần duyệt qua lấy giá trị gán vào điều kiện lọc và xuất file. LÀm như vậy sẽ gọn và linh hoạt hơn.

E TẠO 1 QUERY "MID" VÀ LÀM NHƯ SAU MÀ BÁO LỖI, A XEM GIÚP EM THEO LINK SAU NHÉ (E KO POST ĐC FILE) https://drive.google.com/drive/folders/0By-1v-3ovcUWWWtrQzVyOTRmRGc

Hai Lúa Miền Tây · 9/10/17

hoabattu3387 đã viết:
E TẠO 1 QUERY "MID" VÀ LÀM NHƯ SAU MÀ BÁO LỖI, A XEM GIÚP EM THEO LINK SAU NHÉ (E KO POST ĐC FILE) https://drive.google.com/drive/folders/0By-1v-3ovcUWWWtrQzVyOTRmRGc

Làm cho bạn luôn.

Mã:

Private Sub Command1_Click()
    Dim db As DAO.Database
    Dim rs, rs1 As DAO.Recordset
    Dim qdf As DAO.QueryDef
    Dim mypath As String
    mypath = Access.CurrentProject.Path
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT DISTINCT MID FROM BVL", dbOpenDynaset)
    Label3.Visible = True
    txtMid.Visible = True
    Do While Not rs.EOF
        txtMid = rs("MID")
        With DoCmd
            .OpenReport "rptBVL", acViewPreview, , "[BVL].[MID]='" & txtMid & "'"
            .OutputTo acOutputReport, "rptBVL", acFormatPDF, mypath & "\" & txtMid & ".pdf"
            .Close acReport, "rptBVL"
            Set qdf = db.QueryDefs("chi tiet gui bvl")
            qdf.Parameters(0) = txtMid
            Set rs1 = qdf.OpenRecordset
            .OutputTo acOutputQuery, "chi tiet gui bvl", acFormatXLSX, mypath & "\" & txtMid & ".xlsx"
        End With
        rs.MoveNext
    Loop
    Label3.Visible = False
    txtMid.Visible = False
    Set rs = Nothing
    Set rs1 = Nothing
    Set db = Nothing
    MsgBox "Da thuc hien xong viec xuat du lieu.", vbExclamation
End Sub

Giải nén và chạy file Access nhé.

hoabattu3387 · 9/10/17

Hai Lúa Miền Tây đã viết:

Làm cho bạn luôn.

Mã:

Private Sub Command1_Click()
    Dim db As DAO.Database
    Dim rs, rs1 As DAO.Recordset
    Dim qdf As DAO.QueryDef
    Dim mypath As String
    mypath = Access.CurrentProject.Path
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT DISTINCT MID FROM BVL", dbOpenDynaset)
    Label3.Visible = True
    txtMid.Visible = True
    Do While Not rs.EOF
        txtMid = rs("MID")
        With DoCmd
            .OpenReport "rptBVL", acViewPreview, , "[BVL].[MID]='" & txtMid & "'"
            .OutputTo acOutputReport, "rptBVL", acFormatPDF, mypath & "\" & txtMid & ".pdf"
            .Close acReport, "rptBVL"
            Set qdf = db.QueryDefs("chi tiet gui bvl")
            qdf.Parameters(0) = txtMid
            Set rs1 = qdf.OpenRecordset
            .OutputTo acOutputQuery, "chi tiet gui bvl", acFormatXLSX, mypath & "\" & txtMid & ".xlsx"
        End With
        rs.MoveNext
    Loop
    Label3.Visible = False
    txtMid.Visible = False
    Set rs = Nothing
    Set rs1 = Nothing
    Set db = Nothing
    MsgBox "Da thuc hien xong viec xuat du lieu.", vbExclamation
End Sub

Giải nén và chạy file Access nhé.

Em cảm ơn anh Hai Lúa ạ. Em đọc code của anh và đã hiểu tương đối ạ, nhưng anh có thể xem giúp em vì sao em dùng filter thì bị lỗi là do sai chỗ nào ạ? Em muốn học hỏi thêm cách này nữa. anh giúp em nhé.

Hai Lúa Miền Tây · 9/10/17

hoabattu3387 đã viết:
Em cảm ơn anh Hai Lúa ạ. Em đọc code của anh và đã hiểu tương đối ạ, nhưng anh có thể xem giúp em vì sao em dùng filter thì bị lỗi là do sai chỗ nào ạ? Em muốn học hỏi thêm cách này nữa. anh giúp em nhé.

Tôi không tải file được vì không có quyền

hoabattu3387 · 9/10/17

Hai Lúa Miền Tây đã viết:
Tôi không tải file được vì không có quyền
View attachment 184510

xin lỗi anh, e vừa sharing rồi ạ.

Mã:

Private Sub Command2_Click()

      Dim tblefilename, tblename As String
    tblefilename = Access.CurrentProject.Path
    FName = "\BVL.xlsx"
    tblename = tblefilename & FName
    Dim cn As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & tblefilename & "\POS.accdb")
   cn.Execute ("DELETE * FROM BVL")
    cn.Execute ("insert into [BVL] SELECT * FROM [Excel 12.0;HDR=YES;DATABASE=" & tblename & "].[DetailOfCreditTotalTransaction$A6:Z100] Where MID is not null")
 Set cn = Nothing
End Sub

Private Sub Command3_Click()
Dim tblefilename, tblename As String
tblefilename = Access.CurrentProject.Path
FName = "\BVL.xlsx"
tblename = tblefilename & FName
DoCmd.OutputTo ObjectType:=acOutputQuery, ObjectName:="chi tiet gui bvl", OutputFormat:=acFormatXLSX, Outputfile:=tblefilename & "\chi tiet gui bvl.xlsx"
DoCmd.OutputTo ObjectType:=acOutputReport, ObjectName:="BVL", OutputFormat:=acFormatPDF, Outputfile:=tblefilename & "\BVL.pdf"
DoCmd.OutputTo ObjectType:=acOutputReport, ObjectName:="VTB", OutputFormat:=acFormatPDF, Outputfile:=tblefilename & "\VTB.pdf"
Dim rcs, rcs1 As Recordset
Dim qry, qry1 As QueryDef
Set qry = CurrentDb.QueryDefs("chi tiet gui bvl")
Set qry1 = CurrentDb.QueryDefs("mid")
Set rcs = qry.OpenRecordset
rcs.MoveLast
rcs.Move first
Set rcs1 = qry1.OpenRecordset
For I = 0 To rcs1.RecordCount - 1
With rcs
.Filter = "[Mid] =" & rcs1!Mid
Set orcs = .OpenRecordset
.Close
orcs.MoveLast
orcs.MoveFirst
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, orcs, tblefilename & "\" & I & ".xlsx", True
End With
Next
Set rcs = Nothing
Set rcs1 = Nothing
Set cn = Nothing
End Sub

evolt · 22/6/20

Hai Lúa Miền Tây đã viết:
Bạn chỉnh code sau và chạy thử nhé

Mã:

On Error Resume Next DoCmd.DeleteObject acTable, "BVL" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "BVL", "DuongDanDenFile", True, "DetailOfCreditTotalTransaction!A6:Z17"

Do data của mình quá lớn nên mình phải tách ra thành nhiều file data access khác nhau (cùng cấu trúc), anh @Hai Lúa Miền Tây có thể hướng dẫn giúp mình cách thay tên table name như thế nào để import được đúng file access không anh nhỉ?

Mình đã thử thay dạng

Mã:

DoCmd.TransferSpreadsheet(acImport, _
    acSpreadsheetTypeExcel12Xml, "D:\data1.accdb\Sales", vFileSourceLink, _
    False, "A2:K50000")

code không báo lỗi nhưng hoàn toàn không import vào access.

Cám ơn anh ạ.

tự động cập nhật excel vào access

Thành viên chính thức

File đính kèm

❆❆❆❆❆❆❆❆

Thành viên chính thức

❆❆❆❆❆❆❆❆

File đính kèm

Thành viên chính thức

|||||||||||||

❆❆❆❆❆❆❆❆

Thành viên chính thức

❆❆❆❆❆❆❆❆

Ăn cùng góc phố

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

❆❆❆❆❆❆❆❆

File đính kèm

Thành viên chính thức

❆❆❆❆❆❆❆❆

Thành viên chính thức

Thành viên mới