Lấy lại dữ liệu từ access vào excel
tôi đang thực hiện một dự án, tôi muốn lấy dữ liệu từ access 2007 sang excel. sau khi thực thi đoạn mã này nó sẽ tạo excel mới và dán vào excel đó.
nhưng trong khi thực thi mã này, tôi gặp lỗi ở dòng này.
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
Xin hãy giúp tôi khắc phục điều này.
ở đây tôi đã dán tất cả các mã:
Tùy chọn rõ ràng
CommandSub riêng tư1_Click()
Dim cnt As New ADODB.Connection
Đầu tiên mờ đi như ADODB.Recordset mới
Dim xlApp làm đối tượng
Dim xlWb làm đối tượng
Dim xlWs làm đối tượng
Dim recArray As Variant
Dim strDB dưới dạng chuỗi
Dim fldCount dưới dạng số nguyên
Dim recCount As Long
Dim iCol dưới dạng số nguyên
Dim iRow dưới dạng số nguyên
' Đặt chuỗi theo đường dẫn cơ sở dữ liệu Northwind của bạn
strDB = "C:\Users\mkar\Documents\empdb.accdb"
'Mở kết nối tới cơ sở dữ liệu
' cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Nguồn dữ liệu=" & strDB & ";"
''Khi sử dụng cơ sở dữ liệu Access 2007 Northwind
''nhận xét mã trước và bỏ ghi chú mã sau.
cnt.Open "Nhà cung cấp=Microsoft.ACE.OLEDB.12.0;" & _
"Nguồn dữ liệu=" & strDB & ";"
' Mở recordset dựa trên bảng Đơn hàng
rst.Open "Chọn * Từ emp", cnt
' Tạo một phiên bản Excel và thêm sổ làm việc
Đặt xlApp = CreateObject("Excel.Application")
Đặt xlWb = xlApp.Workbooks.Add
Đặt xlWs = xlWb.Worksheets("Sheet1")
' Hiển thị Excel và cung cấp cho người dùng quyền kiểm soát vòng đời của Excel
xlApp.Visible = Đúng
xlApp.UserControl = Đúng
' Sao chép tên trường vào dòng đầu tiên của bảng tính
fldCount = rst.Fields.Count
Đối với iCol = 1 Để fldCount
xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Kế tiếp
' Kiểm tra phiên bản Excel
Nếu Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Thì
'EXCEL 2000,2002,2003 hoặc 2007: Sử dụng CopyFromRecordset
' Sao chép tập bản ghi vào bảng tính, bắt đầu từ ô A2
xlWs.Cells(2, 1).CopyFromRecordset đầu tiên
'Lưu ý: CopyFromRecordset sẽ thất bại nếu recordset
'chứa một trường đối tượng OLE hoặc dữ liệu mảng như
'dưới dạng các tập bản ghi phân cấp
Khác
'EXCEL 97 trở về trước: Sử dụng GetRows sau đó sao chép mảng vào Excel
' Sao chép recordset vào một mảng
recArray = rst.GetRows
'Lưu ý: GetRows trả về một mảng dựa trên 0 trong đó mảng đầu tiên
'thứ nguyên chứa các trường và thứ nguyên thứ hai
'chứa các bản ghi. Chúng ta sẽ chuyển đổi mảng này sao cho
'chiều thứ nhất chứa các bản ghi, cho phép
'dữ liệu xuất hiện đúng cách khi sao chép sang Excel
' Xác định số lượng bản ghi
recCount = UBound(recArray, 2) + 1 '+ 1 vì mảng dựa trên 0
' Kiểm tra mảng nội dung không hợp lệ khi
' sao chép mảng vào bảng tính Excel
Đối với iCol = 0 Đến fldCount - 1
Đối với iRow = 0 Để recCount - 1
' Chăm sóc các trường Ngày
Nếu IsDate(recArray(iCol, iRow)) thì
recArray(iCol, iRow) = Định dạng(recArray(iCol, iRow))
' Chăm sóc các trường đối tượng OLE hoặc trường mảng
ElseIf IsArray(recArray(iCol, iRow)) Sau đó
recArray(iCol, iRow) = "Trường mảng"
Kết thúc nếu
Bản ghi tiếp theo của iRow 'tiếp theo
iCol 'trường tiếp theo
' Chuyển đổi và sao chép mảng vào bảng tính,
' bắt đầu từ ô A2
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
Kết thúc nếu
' Tự động điều chỉnh độ rộng cột và chiều cao hàng
xlApp.Selection.CurrentRegion.Columns.AutoFit
xlApp.Selection.CurrentRegion.Rows.AutoFit
' Đóng các đối tượng ADO
đầu tiên.Đóng
cnt.Đóng
Đặt đầu tiên = Không có gì
Đặt cnt = Không có gì
' Phát hành tài liệu tham khảo Excel
Đặt xlWs = Không có gì
Đặt xlWb = Không có gì
Đặt xlApp = Không có gì
Kết thúc phụ
Trả lời:
Vì bạn đang sử dụng Office 2007 nên có thể bỏ qua phần dành cho Excel 97: thay đổi toàn bộ phần
' Kiểm tra phiên bản Excel
Nếu Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Thì
EXCEL 2000,2002,2003 hoặc 2007: Sử dụng CopyFromRecordset
' Sao chép tập bản ghi vào bảng tính, bắt đầu từ ô A2
'lWs.Cells(2, 1).CopyFromRecordset đầu tiên
'Lưu ý: CopyFromRecordset sẽ thất bại nếu recordset
'chứa một trường đối tượng OLE hoặc dữ liệu mảng như
'dưới dạng các tập bản ghi phân cấp
Khác
'EXCEL 97 trở về trước: Sử dụng GetRows sau đó sao chép mảng vào Excel
' Sao chép recordset vào một mảng
recArray = rst.GetRows
'Lưu ý: GetRows trả về một mảng dựa trên 0 trong đó mảng đầu tiên
'thứ nguyên chứa các trường và thứ nguyên thứ hai
'chứa các bản ghi. Chúng ta sẽ chuyển đổi mảng này sao cho
'chiều thứ nhất chứa các bản ghi, cho phép
'dữ liệu xuất hiện đúng cách khi sao chép sang Excel
' Xác định số lượng bản ghi
recCount = UBound(recArray, 2) + 1 '+ 1 vì mảng dựa trên 0
' Kiểm tra mảng nội dung không hợp lệ khi
' sao chép mảng vào bảng tính Excel
Đối với iCol = 0 Đến fldCount - 1
Đối với iRow = 0 Để recCount - 1
' Chăm sóc các trường Ngày
Nếu IsDate(recArray(iCol, iRow)) thì
recArray(iCol, iRow) = Định dạng(recArray(iCol, iRow))
' Chăm sóc các trường đối tượng OLE hoặc trường mảng
ElseIf IsArray(recArray(iCol, iRow)) Sau đó
recArray(iCol, iRow) = "Trường mảng"
Kết thúc nếu
Bản ghi tiếp theo của iRow 'tiếp theo
iCol 'trường tiếp theo
' Chuyển đổi và sao chép mảng vào bảng tính,
' bắt đầu từ ô A2
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
Kết thúc nếu
ĐẾN
' Sao chép tập bản ghi vào bảng tính, bắt đầu từ ô A2
xlWs.Cells(2, 1).CopyFromRecordset đầu tiên
Trả lời:
Xin chào Hans MVP
theo lời khuyên của bạn, tôi đã xóa câu lệnh if phiên bản excel, tuy nhiên một lần nữa tôi lại gặp lỗi.
vui lòng kiểm tra mã hóa bên dưới và sửa lỗi này.
CommandSub riêng tư1_Click()
Dim cnt As New ADODB.Connection
Đầu tiên mờ đi như ADODB.Recordset mới
Dim xlApp làm đối tượng
Dim xlWb làm đối tượng
Dim xlWs làm đối tượng
Dim recArray As Variant
Dim strDB dưới dạng chuỗi
Dim fldCount dưới dạng số nguyên
Dim recCount As Long
Dim iCol dưới dạng số nguyên
Dim iRow dưới dạng số nguyên
' Đặt chuỗi theo đường dẫn cơ sở dữ liệu Northwind của bạn
strDB = "C:\Users\mkar\Documents\empdb.accdb"
'Mở kết nối tới cơ sở dữ liệu
' cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Nguồn dữ liệu=" & strDB & ";"
''Khi sử dụng cơ sở dữ liệu Access 2007 Northwind
''nhận xét mã trước và bỏ ghi chú mã sau.
cnt.Open "Nhà cung cấp=Microsoft.ACE.OLEDB.12.0;" & _
"Nguồn dữ liệu=" & strDB & ";"
' Mở recordset dựa trên bảng Đơn hàng
rst.Open "Chọn * Từ emp", cnt
' Tạo một phiên bản Excel và thêm sổ làm việc
Đặt xlApp = CreateObject("Excel.Application")
Đặt xlWb = xlApp.Workbooks.Add
Đặt xlWs = xlWb.Worksheets("Sheet1")
' Hiển thị Excel và cung cấp cho người dùng quyền kiểm soát vòng đời của Excel
xlApp.Visible = Đúng
xlApp.UserControl = Đúng
' Sao chép tên trường vào dòng đầu tiên của bảng tính
fldCount = rst.Fields.Count
Đối với iCol = 1 Để fldCount
xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Kế tiếp
' Sao chép tập bản ghi vào bảng tính, bắt đầu từ ô A2
xlWs.Cells(2, 1).CopyFromRecordset đầu tiên
'Lưu ý: CopyFromRecordset sẽ thất bại nếu recordset
'chứa một trường đối tượng OLE hoặc dữ liệu mảng như
'dưới dạng các tập bản ghi phân cấp
' Xác định số lượng bản ghi
recCount = UBound(recArray, 2) + 1 '+ 1 vì mảng dựa trên 0
' Kiểm tra mảng nội dung không hợp lệ khi
' sao chép mảng vào bảng tính Excel
Đối với iCol = 0 Đến fldCount - 1
Đối với iRow = 0 Để recCount - 1
' Chăm sóc các trường Ngày
Nếu IsDate(recArray(iCol, iRow)) thì
recArray(iCol, iRow) = Định dạng(recArray(iCol, iRow))
' Chăm sóc các trường đối tượng OLE hoặc trường mảng
ElseIf IsArray(recArray(iCol, iRow)) Sau đó
recArray(iCol, iRow) = "Trường mảng"
Kết thúc nếu
Bản ghi tiếp theo của iRow 'tiếp theo
iCol 'trường tiếp theo
' Chuyển đổi và sao chép mảng vào bảng tính,
' bắt đầu từ ô A2
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
Kết thúc nếu
' Tự động điều chỉnh độ rộng cột và chiều cao hàng
xlApp.Selection.CurrentRegion.Columns.AutoFit
xlApp.Selection.CurrentRegion.Rows.AutoFit
' Đóng các đối tượng ADO
đầu tiên.Đóng
cnt.Đóng
Đặt đầu tiên = Không có gì
Đặt cnt = Không có gì
' Phát hành tài liệu tham khảo Excel
Đặt xlWs = Không có gì
Đặt xlWb = Không có gì
Đặt xlApp = Không có gì
Kết thúc phụ
Trả lời:
Bạn chưa xóa tất cả mã mà tôi đã liệt kê.
Comments
Post a Comment