3

アクセスから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で動作させる方法がわかりません。以下の解決策は、私が必要とするものと似たようなことをしているようですが、テーブルを新しいシートにインポートして同じ名前を付ける方法がわかりません。

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
4

1 に答える 1

1

現在開いている Excel ファイルに書き込もうとしているため、最初のバージョンは機能しません。

(2 番目のコードの) 次の行に変更すると、データが別のワークシートにコピーされます。

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"

または、新しいシートを作成することもできます:

Dim wsData As Worksheet

Set wsData = Worksheets.Add
wsData.Name = "1301 Array"
Set TargetRange = wsData.Range("A1")
于 2013-06-18T23:21:23.247 に答える