Access (VBA)

Access VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Access 2016)
既存のリンクテーブル(CSVデータ)をVBAでリンク先を変更したい
投稿日時: 20/03/19 17:53:39
投稿者: ai

お世話になります。
 
ACCESSのファイルあるのですが、
このファイルには、CSVのリンクテーブルを設定しております。
こちらを別のリンク先に変更するVBAをご教示お願い致します。
 
 
ちなみに、リンク元がmdbファイルのリンク変更は、下記VBAで出来ました。↓
 
Dim db As DAO.Database, tb As DAO.TableDef
Set db = CurrentDb
Set tb = db.TableDefs("テーブル名")
   
tb.Connect = ";DATABASE=C:\フォルダ\システム名.mdb;TABLE=テーブル名"
tb.RefreshLink ' リンク情報の更新
 
 
 
 
 
しかし、上記を下に記載したようにリンク元がCSVの場合は
「実行時エラー3343 データベース形式 (略).csvを認識できません。」
とエラーが出てきてしまいます。
 
 
Dim db As DAO.Database, tb As DAO.TableDef
Set db = CurrentDb
Set tb = db.TableDefs("テーブル名")
   
tb.Connect = ";DATABASE=C:\フォルダ\CSVデータ.csv;TABLE=テーブル名"
tb.RefreshLink ' リンク情報の更新
 
 
 
大変お手数なのですが、CSVデータのリンク先を変更をするための
VBAをご教示お願い致します。

回答
投稿日時: 20/03/23 16:12:22
投稿者: sk

引用:
既存のリンクテーブル(CSVデータ)をVBAでリンク先を変更したい

(標準モジュール)
--------------------------------------------------------------------
Public Function RefreshTextLinkTable(LinkTableName As String, _
                                     TextFilePath As String, _
                                     LinkDefName As String) As Boolean
'**** 引数の説明 ****
'LinkTableName: テキストリンクテーブルの名前
'TextFilePath: リンク先となるテキストファイルのフルパス
'LinkDefName: リンク定義の名前
                                     
On Error GoTo Err_RefreshTextLinkTable
     
    RefreshTextLinkTable = False
     
    Dim ws As DAO.Workspace
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
     
    Dim strFolderPath As String
    Dim strFileName As String
    Dim strConnect As String
     
    Set ws = DBEngine.Workspaces(0)
    Set db = CurrentDb
     
    'リンクテーブルのチェック
    On Error Resume Next
    Set tdf = db.TableDefs(LinkTableName)
    Select Case Err.Number
        Case 0
            '何もしない
        Case 3265
            MsgBox "テーブル[" & LinkTableName & "]はカレントデータベース上に存在しません。", _
                   vbExclamation, _
                   "テーブル参照エラー"
            Set tdf = Nothing
            Set db = Nothing
            Set ws = Nothing
            Exit Function
        Case Else
            GoTo Err_RefreshTextLinkTable
    End Select
    On Error GoTo Err_RefreshTextLinkTable
     
    With tdf
        Debug.Print "Name: " & .Name
        Debug.Print "Connect: " & .Connect
        Debug.Print "SourceTableName: " & .SourceTableName
        If Not .Connect Like "Text;*" Then
            MsgBox "[" & LinkTableName & "]はテキストリンクテーブルではありません。", _
                   vbExclamation, _
                   "テーブル参照エラー"
            Set tdf = Nothing
            Set db = Nothing
            Set ws = Nothing
            Exit Function
        End If
    End With
    Set tdf = Nothing
     
    'ファイルの実在チェック
    strFileName = Dir(TextFilePath)
    If strFileName = "" Then
        MsgBox TextFilePath & " を参照出来ません。パスの指定が正しいか否かを確認して下さい。", _
               vbExclamation, _
               "ファイル参照エラー"
        Exit Function
    End If
         
    'フォルダパスの取得
    strFolderPath = Left(TextFilePath, Len(TextFilePath) - Len(strFileName) - 1)
     
    '接続文字列の構成(区切り記号付き可変長テキストファイル、日本語(シフトJIS)の場合)
    strConnect = "Text;DSN=" & LinkDefName & _
                 ";FMT=Delimited;HDR=NO;IMEX=2;CharacterSet=932" & _
                 ";DATABASE=" & strFolderPath
     
    'トランザクション開始
    ws.BeginTrans
    On Error GoTo RollBack_RefreshTextLinkTable
     
    'リンクテーブルの削除
    db.TableDefs.Delete LinkTableName
    db.TableDefs.Refresh
     
    'リンクテーブルの再作成
    Set tdf = db.CreateTableDef(LinkTableName)
    tdf.Connect = strConnect
    tdf.SourceTableName = strFileName
    db.TableDefs.Append tdf
    db.TableDefs.Refresh
 
    'コミット
    ws.CommitTrans
    On Error GoTo Err_RefreshTextLinkTable
     
    RefreshTextLinkTable = True
     
'終了処理
Exit_RefreshTextLinkTable:
On Error Resume Next
     
    Set tdf = Nothing
    Set db = Nothing
    Set ws = Nothing
     
    Exit Function
     
'エラー時処理(ロールバック付き)
RollBack_RefreshTextLinkTable:
    'ロールバック
    ws.Rollback
     
'エラー時処理
Err_RefreshTextLinkTable:
 
    Dim strMsg As String
     
    strMsg = Err.Number & ": " & Err.Description
    Debug.Print strMsg
    MsgBox strMsg, vbCritical, "実行時エラー"
     
    Resume Exit_RefreshTextLinkTable
End Function
--------------------------------------------------------------------
 
(呼び出し例)
--------------------------------------------------------------------
Private Sub Test()
 
    RefreshTextLinkTable "リンクテーブル名", _
                         "C:\FolderName\FileName.csv", _
                         "リンク定義名"
 
End Sub
--------------------------------------------------------------------
 
以上のサンプルのようなコードを実行なさればよろしいかと。

投稿日時: 20/03/25 10:43:09
投稿者: ai

sk様
 
ありがとうございます!
一つお聞きしたいのですが、
現在はACCESSのファイル上で設定しているリンク名は「CSV_商品マスタ」という名前を使っており
元々のCSVデータは「C:\元のCSVファイル\商品マスタ.csv」にあったとしてこれを
「C:\変更先CSVファイル\商品マスタ.csv」の場所に設定しているリンク先を変更したい場合
下記3つの値は何を入れたらよろしいでしょうか?
 
 
LinkTableName: CSV_商品マスタ
TextFilePath: C:\変更先CSVファイル\商品マスタ.csv
LinkDefName: CSV_商品マスタ
 
 
と入れてみたのですが、
「3625:テキストファイルの指定CSV_商品マスタが存在しません。
 この指定を使用して〜(略)リンクすることはできません)
と出てきてしまいます。
 
db.TableDefs.Append tdf
の処理の所でこのエラーが発生しているようです。
 
度々申し訳ございませんが、ご教示のほどよろしくお願い致します。

回答
投稿日時: 20/03/25 11:36:00
投稿者: sk

引用:
現在はACCESSのファイル上で設定しているリンク名は
「CSV_商品マスタ」という名前を使っており
元々のCSVデータは「C:\元のCSVファイル\商品マスタ.csv」にあったとして
これを「C:\変更先CSVファイル\商品マスタ.csv」の場所に
設定しているリンク先を変更したい場合
下記3つの値は何を入れたらよろしいでしょうか?

引用:
LinkTableName: CSV_商品マスタ
TextFilePath: C:\変更先CSVファイル\商品マスタ.csv
LinkDefName: CSV_商品マスタ

LinkDefName には、リンクテーブルの名前ではなく
リンク定義の名前を指定して下さい。
 
テーブルの構造自体(各フィールドの名前やデータ型)が
変更されるわけではないのであれば、元から使用されていた
リンク定義の名前をそのまま渡せばよいでしょう。
 
コードを実行する前の時点において[CSV_商品マスタ]に対して
どのような接続文字列が設定されているかについては、
イミディエイトウィンドウの出力内容をご確認下さい。
 
引用:
With tdf
    Debug.Print "Name: " & .Name
    Debug.Print "Connect: " & .Connect

投稿日時: 20/03/27 10:45:42
投稿者: ai

sk様
 
LinkDefNameは下記でご教示頂いたものを実行して、
入れる物が分かりました!
 
With tdf
    Debug.Print "Name: " & .Name
    Debug.Print "Connect: " & .Connect
 
 
 
長いVBAを記載頂いて申し訳ありませんでした・・・。
ありがとうございました^^