我正在尝试开发一款应用程序，该应用程序具有从access导入数据到excel的功能。在让用户控制哪个表之前，我从一个名为“1301 Array”的表开始。问题是我遇到了错误“无法修改表结构。另一个用户已经打开了该表”，可能是因为我正在编写的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
我在网上找到的解决方案大多使用sql，但我不知道如何编写sql语句，也不知道他们如何在excel vba中使用sql。下面的解决方案似乎与我需要的类似，但我不确定如何调整以将表导入新工作表并赋予相同的名称。
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
更新：我打算尝试使用这种方法。
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