[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ADOでリンクテーブルの接続』（TAKA）
宜しくお願いします。EXCEL,2007 ACCESS,2010です。
社内のPC-AとPC-BがありましてPC-Aのデスクトップ上の共有フォルダにリンク.accdbのファイルがあります。クエリなど５個程のテーブルをリンクさせております。ちなみにPC-AのみACCESSがインストールされています。PC-AのEXCELから下記コードを実行すると作動しますがPC-Bから操作すると「パス'C\Users....accdbは正しくありません。パス名に間違いないことと、ファイルが置かれたサーバーに接続していることを確認してください。」とエラーが表示されます。
質問内容はACCESSのリンクテーブルを使用してフルパスで他のPCからデータの抽出は可能でしょうか？仕様は共有フォルダのEXCELからADOを利用してテーブルのレコード更新、変更、削除（同時に編集できないようにEXCEL VBAで制御はしています。）クエリなどの抽出はACCESSのリンクテーブルで行いたいと考えています。
申し訳ございませんが抽出方法を教えて下さい。
Dim db As Object, rs As Object, cmd As Object, SQL As String
SQL 〜 省略 〜
Set db = CreateObject("ADODB.Connection")
db.Provider = "Microsoft.Ace.OLEDB.12.0"
db.Open ThisWorkbook.Path & "\リンク.accdb"
Set rs = CreateObject("ADODB.Recordset")
Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = db
cmd.CommandText = SQL
Set rs = cmd.Execute
If rs.EOF Then MsgBox "抽出した結果、レコードが見つかりません。"
Else
Range("a3").CopyFromRecordset rs
End If
rs.Close: db.Close
Set rs = Nothing: Set db = Nothing
ThisWorkbook.Path & "\リンク.accdb"
ネットワーク越しにファイルを参照するには
パスは\\****\**\リンク.accdbとなります。
PC-BからPC-Aの共有フォルダを開きリンク.accdbのプロパティを見て
フルパスを確認しましょう。
PC-Aも、\\****\**\リンク.accdbで接続できますが、ネットワーク越しに接続
する形になるので速度が落ちます。
PC-AはThisWorkBook.Path
PC-Bは\\****\**\リンク.accdb
で利用するようにします。
ここで問題になるのが、パスのハードコーディングです。（直にパスを書いてしまう）
利用する環境が変わった。Excelファイルを修正し配布し直した時などの事
を考えるとうまい仕組みが必要ですね。
・iniファイルに接続パスを仕込みOpen毎にiniファイルからパスを得る
・隠しシートに接続パスを仕込む
接続パスを返す関数を作成
Public Function GetDbPath() As String
Dim sh As WorkSheet
Set sh = WorkSheets("隠しシート名")
GetDbPath = sh.Range("A1").Value 'A1にはフルパス
End Function
使用例
db.Open GetDbPath
接続先を選択して登録できる仕組みを作成します。(GetOpenFileNameなどで）
選択されたaccessファイルのパスをiniファイルや隠しシートに登録します。
この時大事なのは、上でも書きましたがPC-Aは必ず自デスクトップ上の
フォルダを直接選択し登録することです。ネットワーク→共有フォルダと
辿ってしまうと折角自PC上にあるのに速度低下を招きます。
このような仕組みを作成しておけば、環境が変わったり配布する数が多くなって
きても直ぐ対応出来ます。
(DonDon)
>テーブルをリンクさせております このリンク元のaccdbファイルは、PC-Bから見れる場所にあるんですか？
これも共有しておかないと、操作は、できませんよ！！
確認してみてください。
私は、Excelブックは、最近は、一つで共有させえていますよ、 最初から、読み取り専用にしていますから・・・。Excelにコードを置くのですから、 これに通常は、書き込みはしませんから・・・。
ichinose
回答ありがとうございました。
DonDon様、作動するか検証したいと思います。すいません！少しお時間を下さい。
ichinose様、PC-AにのみACCESSが導入しており、共有フォルダにテーブルのみのaccdbファイルをいくつも作成してあります。そのテーブルaccdbから同じ共有フォルダにリンクaccdbにリンクさせております。
EXCELファイルも同じ共有フォルダに複数入っておりますが、他の人が使用しているとBOOKを開けないよう制御はしています。
元々accdbファイルは一つでその中でテーブルやクエリを作成していましたが、先日、accdbがフリーズしてしまい。対策としてテーブルごとにファイルを作成して更新用と集計、抽出用のリンクテーブルを作成したほうがよいかと思いました。
PC-Bから共有フォルダ（PC-A）のリンク.accdbから抽出できたらと考えています。
DonDon様の回答も踏まえて色々トライしてみようと思います。
>PC-Bから共有フォルダ（PC-A）のリンク.accdbから抽出できたらと リンクテーブル設定時にUNCパスで設定されていますか？ そうでなかったら、UNCパスでリンクテーブルを再設定してみて下さい
ichinose
ネットワーク越しにファイルを参照するにはサーバー名を指定すればよかったのですね！勉強になりました。
UNCパスでリンクテーブルを再設定したらあっさり作動しました。
後は、Excelファイルを全てのPCに配布しようか悩んでおります。今後のメンテナンス等も含めて色々トライしてみようと思います。
リンクテーブルもThisWorkbook.Pathみたいに簡単にフルパスができればよいのですが・・・ネットで調べるとVBAでできるみたいなことは書いてあったのですが。自宅にUSBで持ち帰るとリンクを再設定するのが大変なので今度、勉強してみようと思います。
返事が遅くなり申し訳ございませんでした。ありがとうございました。仕事で月末処理が終わらなかったので・・・
（TAKA）
>リンクテーブルもThisWorkbook.Pathみたいに簡単にフルパスができればよいのですが・・・ネットで調べるとVBAでできるみたいなことは書いてあったのですが
私も以前、テーブルリンク設定コードを調べた事がありました。 私は、これを仕事では使ったことがありませんが・・・。
Adox.Catalog を使って、既存テーブル属性を調べるとリンクテーブルの作成は、 出来ると思いますよ！！
標準モジュール（Module1）にAdox I/O プロシジャー群
'============================================================================
Private cat As Object 'ADOX.Catalog
Function open_cat(flnm As String) As Long
On Error Resume Next
Set cat = CreateObject("ADOX.Catalog")
cat.ActiveConnection = "Provider=Microsoft.Ace.OLEDB.12.0;" & _
"Data Source=" & flnm
open_cat = Err.Number
On Error GoTo 0
End Function
'=================================================================
Function get_cn() As Object
Set get_cn = cat.ActiveConnection
End Function
'=================================================================
Function create_lnktbl(tblnm As String, l_tblnm As String, ldbnm As String, Optional pwd As String = "", Optional exstr As String = "") As Long
'リンクテーブルを作成する
'Input:tblnm----テーブル名
' l_tblnm--リンク先テーブル名
' ldbnm----リンク先dbのフルパス
' pwd------リンク先にパスワードが設定されている場合、そのパスワード（省略可）
' exstr----他のデータベース（Excelやtxtファイル、etc）をリンクするときの追加ストリング（省略可）
'Output:create_lnktbl----0--正常終了,その他：異常終了
On Error GoTo err_lnkcreate_tbl
Dim tbl As Object 'ADOX.Table
create_tbl = 0
Set tbl = CreateObject("ADOX.Table")
tbl.Name = tblnm
Set tbl.ParentCatalog = cat
With tbl
.Properties("Jet OLEDB:Create Link").Value = True
.Properties("Jet OLEDB:Remote Table Name").Value = l_tblnm
.Properties("Jet OLEDB:Link Datasource").Value = ldbnm
If pwd <> "" Then .Properties("Jet OLEDB:Link Provider String") = ";pwd=" & pwd
If exstr <> "" Then
.Properties("Jet OLEDB:Link Provider String").Value = exstr
End If
End With
cat.Tables.Append tbl
Set tbl = Nothing
ret_lnkcreate_tbl:
On Error GoTo 0
Exit Function
err_lnkcreate_tbl:
MsgBox Error(Err.Number)
create_tbl = Err.Number
Resume ret_lnkcreate_tbl
End Function
'=================================================================
Sub close_cat()
On Error Resume Next
cat.ActiveConnection.Close
Set cat = Nothing
On Error GoTo 0
End Sub
別の標準モジュール（Module2）に
'==========================================================================
Sub mk_lnktbl()
Dim uncp As String
With CreateObject("wscript.network")
uncp = "\\" & .computername & "\" & Replace(ThisWorkbook.Path, ":", "")
End With
If open_cat(ThisWorkbook.Path & "\Linktest.accdb") = 0 Then
Call create_lnktbl("newtbl1", "Testtbl", uncp & "\testacc.accdb")
End If
Call close_cat
End Sub
mk_lnktblの実行で このVBAコードを含むExcelブックと同じフォルダ上にある
Linktest.accdb というデータベースファイル上に
同じフォルダ上にあるtestacc.accdb内のTesttblというテーブルを
newtbl1 というテーブル名でリンクテーブルを作成します。
UNCパス変換は、WMIかAPIを使えばできるかもしれませんが、 今回は、WSHでコンピュータ名を取得し、あとは、文字列の置き換えで作成しました。
又、create_lnktblは、パラメータの指定で、Excelシートやtxtなどもリンク可能にしてあります。
参考になれば、幸いです。
ichinose
とりあえず下記内容でリンクの変更をトライ中ですが、うまくいかず相談させて下さい。PC-Aのフォルダの中にaaa.accdb, bbb ccc のファイルとリンク.accdbがあり、例えばaaa.accdbファイルにT_aaaのテーブルが一対でテーブルを作成しています。
リンク.accdbの標準モジュールに下記コードで一括変更したいのですが、DATABASE=\\・・・の所で処理が止まってしまい教えて頂けないでしょうか？文字列の結合の部分だと思うのですが・・
Dim tdf As TableDef, dbs As Database
Dim tbl() As Variant, fil() As Variant, i As Byte
'Microsoft DAO 3.6 Object Library参照設定
tbl = Array("T_aaa", "T_bbb", "T_ccc") 'テーブル名
fil = Array("aaa", "bbb", "ccc") 'accdbファイル名
Set dbs = CurrentDb
For i = 0 To UBound(tbl)
Set tdf = dbs.TableDefs(tbl(i))
With tdf
.Connect = ";DATABASE=\\サーバー名\(省略)\フォルダ名\" & fil(i) & ".accdb";TABLE=" & tbl(i)
.RefreshLink
End With
Set tdf = Nothing
Next i
MsgBox "リンクテーブルの変更が完了しました。"
dbs.Close: Set dbs = Nothing
（TAKA）
今度は、DAOですか？ 私はDAOは、普段使わないのですが・・・、
Sub test()
Dim tdf As TableDef, dbs As Database
Dim tbl() As Variant, fil() As Variant, i As Byte
Dim uncp As String
uncp = "\\" & CreateObject("wscript.network").computername
With CreateObject("scripting.filesystemobject")
uncp = uncp & "\" & Replace(.GetParentFolderName(CurrentDb.Name), ":", "")
End With
tbl = Array("T_aaa", "T_bbb", "T_ccc") 'テーブル名
fil = Array("aaa", "bbb", "ccc") 'accdbファイル名
Set dbs = CurrentDb
For i = 0 To UBound(tbl)
Set tdf = dbs.TableDefs(tbl(i))
With tdf
.Connect = ";DATABASE=" & uncp & "\" & fil(i) & ".accdb;TABLE=" & tbl(i)
.RefreshLink
End With
Next i
MsgBox "リンクテーブルの変更が完了しました。"
dbs.Close
Set tdf = Nothing
Set dbs = Nothing
End Sub
ichinose@ＧＷ中の旅行で食べ過ぎ・・・
教えて頂いたコードにてトライしました。最初の質問の時のエラー表示がされます。msgbox uncpで確認すると、\\サーバー名\C\・・・・と恐らくドライブ名も連結されている為かと思われます。
とりあえず自分が掲示したコードの連結部分を修正したら作動しましたので下記のように都度、環境に合わせて切り替えようと思います。テーブルが増えるとArrayの部分で追加して・・・VBAのようで手動なんですけど（笑）
ichinose様、色々とお世話をおかけしました。大変助かりました。
With tdf
.Connect = ";DATABASE=\\サーバー名\(省略)\フォルダ名\" & fil(i) & ".accdb;TABLE=" & tbl(i)
'.Connect = ";DATABASE=\\サーバー名\(省略)\フォルダ名\" & fil(i) & ".accdb;TABLE=" & tbl(i)
.RefreshLink
End With
（TAKA）
>\\サーバー名\C\・・・・と恐らくドライブ名も連結されている為 あっ、そうですねえ、そういう場合もありますねえ！！ やっぱり、共有一覧と照らし合わせないと駄目ですねえ！！
一覧は、WMIを探ってみたらありました。
http://www.wmifun.net/sample/win32_share.html
この一覧と照合する方法でしょうかねえ！！
ichinose
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.