Vbaでアクセスからエクセルにリンクテーブルする

Vbaでアクセスからエクセルにリンクテーブルするには？
エクセルの情報：
C:\Users\Desktop￥新規 Microsoft Excel ワークシート.xlsx

シート１の情報：
フィールド1　フィールド2
あああ　　　　ａａａ
いい　　　　　iii
ううう　　　　uuu
なのですが、
アクセスからＶＢＡでリンクするにはどうすれば良いでしょう？

手作業なら
外部データ→エクセル→外部データの取り込み→リンクテーブルを作成してソースデータにリンクする
でリンクできますが、ｖｂａで行いたいです。

Sub Sample01()
Dim db As DAO.Database, tb As DAO.TableDef

Set db = CurrentDb
Set tb = db.TableDefs("Sheet1")

tb.Connect = ";DATABASE=" & CurrentProject.FullName & ";TABLE=Sheet1"
tb.RefreshLink ' リンク情報の更新
End Sub

このコードは意味が違いますよね

エクセルのパスとシート名を指定してリンクする方法を教えてください。

最終定期にはシートをループして複数のテーブルを作成したいのです。
リンクが無理ならインポートでもＯＫです。

No.2 ベストアンサー 回答者： nicotinism 回答日時： 2013/04/12 00:04

手作業でExcelへのリンクテーブルを作って

テーブルをデザインビューで開いてプロパティの「説明」を覗いてみた。
Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=D:\DB\SampleData\Small.xlsx;TABLE=Sheet1$
これをConnect に渡せば良いらしい。
IMEX ？
ACCDB ？
分からないのでGoogleと
こちらでも素晴らしい回答をされているkikuさんの
http://kikutips.blog13.fc2.com/blog-entry-107.html
を発見。

http://www.f3.dion.ne.jp/~element/msaccess/AcTip …
こちらではIMEXに関わる説明がされています。

docmd.TransferSpreadsheet acLink ,acSpreadsheetTypeEx・・後略でシートの一部分だけだと
（VBAのヘルプで↑を調べてください）
Excel 12.0 Xml;HDR=NO;IMEX=2;ACCDB=YES;DATABASE=D:\DB\SampleData\Small.xlsx;TABLE=sheet2$B5:D16
とかになりました。
直接、接続情報を指定するもよし、docmd.TransferSpreadsheet・・・でもお好きな方で。
今日はとても賢くなった。寝たら忘れるかも。。。

この回答へのお礼

リンク先見ました

いろんなパターンが書かれていてすごく参考になりました。
nicotinism様の回答はいつも参考にしています。
とても賢い方だと思っていて尊敬しています。

お礼日時：2013/04/12 20:27

No.1 回答者： mitarashi 回答日時： 2013/04/11 20:46

試しにやってみました

Access2010で、カレントデータベース(mdb形式）にxls形式のファイルに対してリンクテーブルを作成しました。
excel 8.0のところは、試みに他のバージョン番号(xl2003なら11.0とか）を入れるとエラーになりました。
また、accdb形式のデータベースにxlsx/xlsm形式のワークシートをリンクさせるには、excel 12.0に変更する必要がありました。（mdbへの、xlsx/xlsmのリンクは拒絶されました。）
なお、リンクテーブル作成に成功しても、一旦データベースウィンドウを消して再表示させないと、反映されない事がありました。
以上、ご参考まで。(デスクトップのパス取得はテストの都合でつけてあります、あしからず）
Sub test()
Dim DB As Database
Dim rst As Recordset
Dim tblExcel As TableDef

Set DB = CurrentDb
Set tblExcel = DB.CreateTableDef("linked excel worksheet")
tblExcel.Connect = "excel 8.0;" & "database=" & GetDesktopPath & "\" & "hoge..xls"
tblExcel.SourceTableName = "Sheet1$"
DB.TableDefs.Append tblExcel
DB.Close
Set rst = Nothing
Set tblExcel = Nothing
Set DB = Nothing
End Sub

Private Function GetDesktopPath() As String
Dim wScriptHost As Object, strInitDir As String
Set wScriptHost = CreateObject("Wscript.Shell")
GetDesktopPath = wScriptHost.SpecialFolders("Desktop")
Set wScriptHost = Nothing
End Function

参考URL：http://www.moug.net/tech/acvba/0090012.html

この回答へのお礼

すごい！できました！
ご回答ありがとうございました。

しかも自動的に1行目はフィールドになってくれるようですね。
DAOを使うのですか。

お礼日時：2013/04/12 20:27