[英]Importing data from access into an open excel spreadsheet? (Excel VBA)
I am trying to make an application that has the feature to import data from access into excel. 我正在尝试创建一个具有将数据从访问导入到Excel中的功能的应用程序。 I am starting with a table named ""1301 Array"" before I give user control over which table. 在我让用户控制哪个表之前,我开始使用名为“”1301 Array“”的表。 The problem is I get the error "Cannot modify table structure. Another user has the table open", assuming because of the excel sheet I am writing in. Is there a work around to use TransferSpreadsheet for this? 问题是我得到错误“无法修改表结构。另一个用户打开了表”,假设因为我正在写的excel表。是否有解决方法使用TransferSpreadsheet?
Sub Importfromaccess()
Dim accappl As Access.Application
Dim strpathdb As String
Dim strpathxls As String
strpathdb = Application.GetOpenFilename("Access DataBase (*.accdb),*.accdb")
strpathxls = ActiveWorkbook.FullName
Set accappl = New Access.Application
accappl.OpenCurrentDatabase strpathdb
Dim Page As Worksheet
Dim lRow As Long, LCol As Long
Dim fullrange As String
Dim PageName As Variant
accappl.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "1301 Array", strpathxls, True
accappl.Quit
End Sub
The solutions I have found online mostly use sql, but I have no idea how to write in that, or how they got sql to work in excel vba. 我在网上找到的解决方案大多使用sql,但我不知道如何编写,或者他们如何让sql在excel vba中工作。 The solution below seems to do something similar to what I need, but I'm not sure how to tweak to import a table into a new sheet and give it the same name. 下面的解决方案似乎做了类似于我需要的东西,但我不确定如何调整将表导入新表并给它相同的名称。
Sub Workbook_Open()
Dim cn As Object, rs As Object
Dim intColIndex As Integer
Dim DBFullName As String
Dim TargetRange As Range
DBFullName = "D:\Tool_Database\Tool_Database.mdb"
Application.ScreenUpdating = False
Set TargetRange = Sheets("Sheet1").Range("A1") '1301 Array after creating it?
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT * FROM ToolNames WHERE Item = 'Tool'", cn, , , adCmdText
' Write the field names
For intColIndex = 0 To rs.Fields.Count - 1
TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
Next
' Write recordset
TargetRange.Offset(1, 0).CopyFromRecordset rs
End Sub
Update: Am going to try and use this method 更新:我将尝试使用此方法
Sub AccessToExcel()
'Declare variables.
Dim dbConnection As ADODB.Connection
Dim dbRecordset As ADODB.Recordset
Dim dbFileName As String
Dim strSQL As String
Dim DestinationSheet As Worksheet
'Set the assignments to the Object variables.
Set dbConnection = New ADODB.Connection
Set dbRecordset = New ADODB.Recordset
Set DestinationSheet = Worksheets("Sheet2")
'Define the Access database path and name.
dbFileName = "C:\YourFilePath\Database1.accdb"
'Define the Provider for post-2007 database files.
dbConnection.Provider = "Microsoft.ACE.OLEDB.12.0;Data Source=" _
& dbFileName & ";Persist Security Info=False;"
'Use SQL's SELECT and FROM statements for importing Table1.
strSQL = "SELECT Table1.* FROM Table1;"
'Clear the destination worksheet.
DestinationSheet.Cells.Clear
With dbConnection
'Open the connection.
.Open
'The purpose of this line is to disconnect the recordset.
.CursorLocation = adUseClient
End With
With dbRecordset
'Create the recordset.
.Open strSQL, dbConnection
'Disconnect the recordset.
Set .ActiveConnection = Nothing
End With
'Copy the Table1 recordset to Sheet2 starting in cell A2.
'Row 1 contains headers that will be populated at the next step.
DestinationSheet.Range("A2").CopyFromRecordset dbRecordset
'Reinstate field headers (assumes a 4-column table).
'Note that the ID field will also transfer into column A,
'so you can optionally delete column A.
DestinationSheet.Range("A1:E1").Value = _
Array("ID", "Header1", "Header2", "Header3", "Header4")
'Close the recordset.
dbRecordset.Close
'Close the connection.
dbConnection.Close
'Release Object variable memory.
Set dbRecordset = Nothing
Set dbConnection = Nothing
Set DestinationSheet = Nothing
End Sub
The first version won't work because you are attempting to write to the Excel file that you currently have open. 第一个版本将无法工作,因为您正在尝试写入当前打开的Excel文件。
Changing to the following line (of the 2nd code) will copy the data to another worksheet: 更改为(第二个代码的)以下行将数据复制到另一个工作表:
Set TargetRange = Sheets("WhateverName").Range("A1") 'or
Set TargetRange = Sheets(2).Range("A1")
'..if you know it is the 2nd sheet that
'you want to copy to. Then,
Worksheets(2).Name = "1301 Array"
You could, alternatively, create a new sheet: 或者,您可以创建一个新工作表:
Dim wsData As Worksheet
Set wsData = Worksheets.Add
wsData.Name = "1301 Array"
Set TargetRange = wsData.Range("A1")
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.