Đọc ghi dữ liệu với mảng Array vào Sheet và vào Bảng trong Accsess

[ngocbinh.no.kia]

Tôi có một file mẫu excel đang loay hoay đọc ghi dữ liệu vào sheets DATA và đọc ghi dữ liệu vào một file accsees có bảng giống bảng sheest DATA; nhờ các cao nhân giúp hoàn thiện Code VBA

 

[Maika8008]

Tôi gửi bạn code lấy chép tất cả các sheet của 1 file đang đóng sang Access, mỗi sheet thành 1 table Access.

Dữ liệu file Excel bắt đầu từ cột A, dòng 1 là tiêu đề.

Sub AccImport()
    Dim Sh As Worksheet, C&, R&, Adrs$, CName$
    Dim WbD As Workbook
    Dim acc As New Access.Application
    Application.ScreenUpdating = False
    acc.OpenCurrentDatabase "D:\TestGPE\DataTN1.accdb"  'Thay duong dan va ten
    Set WbD = Workbooks.Open("D:\TestGPE\DuLieu.xlsx")  ''Thay duong dan va ten
    For Each Sh In WbD.Worksheets
        C = Sh.Range("XFD1").End(xlToLeft).Column
        CName = Mid(Cells(1, C).Address, 2, InStrRev(Cells(1, C).Address, "$") - 2)
        R = Sh.Range("A" & Rows.Count).End(xlUp).Row
        Adrs = Sh.Name & "$A1:" & CName & R
        acc.DoCmd.TransferSpreadsheet _
                TransferType:=acImport, _
                SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
                TableName:=Sh.Name, _
                Filename:=WbD.FullName, _
                HasFieldNames:=True, _
                Range:=Adrs
    Next
    WbD.Close False
    Set WbD = Nothing
    acc.CloseCurrentDatabase
    acc.Quit
    Set acc = Nothing
    Application.ScreenUpdating = True
End Sub

 

[ngocbinh.no.kia]

Tôi gửi bạn code lấy chép tất cả các sheet của 1 file đang đóng sang Access, mỗi sheet thành 1 table Access.

Dữ liệu file Excel bắt đầu từ cột A, dòng 1 là tiêu đề.

Sub AccImport()
    Dim Sh As Worksheet, C&, R&, Adrs$, CName$
    Dim WbD As Workbook
    Dim acc As New Access.Application
    Application.ScreenUpdating = False
    acc.OpenCurrentDatabase "D:\TestGPE\DataTN1.accdb"  'Thay duong dan va ten
    Set WbD = Workbooks.Open("D:\TestGPE\DuLieu.xlsx")  ''Thay duong dan va ten
    For Each Sh In WbD.Worksheets
        C = Sh.Range("XFD1").End(xlToLeft).Column
        CName = Mid(Cells(1, C).Address, 2, InStrRev(Cells(1, C).Address, "$") - 2)
        R = Sh.Range("A" & Rows.Count).End(xlUp).Row
        Adrs = Sh.Name & "$A1:" & CName & R
        acc.DoCmd.TransferSpreadsheet _
                TransferType:=acImport, _
                SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
                TableName:=Sh.Name, _
                Filename:=WbD.FullName, _
                HasFieldNames:=True, _
                Range:=Adrs
    Next
    WbD.Close False
    Set WbD = Nothing
    acc.CloseCurrentDatabase
    acc.Quit
    Set acc = Nothing
    Application.ScreenUpdating = True
End Sub

Cái này không cần đến, chủ yếu là cập nhật, sửa, xoá dữ liệu trong bảng thì hữu dụng hơn, dù sao cũng cảm ơn bạn đã quan tâm

 

[Maika8008]

Cái này không cần đến, chủ yếu là cập nhật, sửa, xoá dữ liệu trong bảng thì hữu dụng hơn, dù sao cũng cảm ơn bạn đã quan tâm

Ờ, không cần sao ta? Nếu ai đó giúp code tổng hợp Excel rồi thì làm sao cho vào Access?

 

[ngocbinh.no.kia]

Ờ, không cần sao ta? Nếu ai đó giúp code tổng hợp Excel rồi thì làm sao cho vào Access?

Ồ ha; cứ lưu lại rồi sẽ cần; Bác cho hỏi thêm xem ưu điểm của Phương pháp (đoạn code) đó là gì; chạy thử thấy cũng hay hay

Bài đã được tự động gộp: 3/9/21

Có chỉ định lấy sheet cụ thể nào sang được không; vì hình như quét tất cả sheet thì sẽ bị lỗi.

 

[Maika8008]

Ồ ha; cứ lưu lại rồi sẽ cần; Bác cho hỏi thêm xem ưu điểm của Phương pháp (đoạn code) đó là gì; chạy thử thấy cũng hay hay

Bài đã được tự động gộp: 3/9/21

Có chỉ định lấy sheet cụ thể nào sang được không; vì hình như quét tất cả sheet thì sẽ bị lỗi.

Chỉ định sheet cụ thể nào đó thì bỏ vòng lặp đi, ghi rõ sheet name. Dữ liệu hầm bà lằng thì lỗi thôi.

 

[ngocbinh.no.kia]

Tìm được cái code UPDATE 1 dòng vào bảng: Ghi dữ liệu từ Sheets("DATA") vào Bảng DATA_HD trong Accsess có cùng cấu trúc bảng.
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim qry As String
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\BDATA.accdb" ' Thay doi duong dan file access
' Ghi du lieu vao bang DATA_HD
If Range("SOHD").Value <> "" Then
qry = "SELECT * FROM DATA_HD WHERE SOHD = " & Range("SOHD").Value
Else
qry = "SELECT * FROM DATA_HD Where SOHD = 0"
End If

rst.Open qry, cnn, adOpenKeyset, adLockOptimistic

If rst.RecordCount = 0 Then
rst.AddNew
End If
' Ghi du lieu dong 2 sheets DATA vao bang trong accsess
For i = 1 to 50
rst.Fields(i).Value = sheets("DATA").cells(2,i).value
next i
rst.update

rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
MsgBox "Updated Successfully", vbInformation
End Sub

 

[Maika8008]

Ủa, chứ việc loay hoay kia quên mất rồi sao?