【Access VBA】Excelワークシートのリンクテーブル追加／リンクテーブル削除／テーブルのリンク先変更　サンプル

AccessからExcelワークシートをリンクテーブルとしてリンクさせる際のサンプル

1. リンクテーブルを追加する
2. リンクテーブルを削除する
3. リンクテーブルのリンク先を変更する

上記３点に絞って実装。

Option Compare Database
Option Explicit

Sub TestLinkExcelSample()

    Call LinkExcelDAO_ADD("C:\都道府県.xls", "sheet1", "Linked Sheet1")
    Call LinkExcelDAO_DEL("Linked Sheet1")
    Call LinkExcelDAO_ADD("C:\都道府県.xls", "sheet1", "Linked Sheet2")
    Call LinkExcelDAO_MOD("C:\都道府県2.xls", "sheet1", "Linked Sheet2")

    Call LinkExcelDAO_CHK
End Sub

‘リンクの追加
Private Function LinkExcelDAO_ADD(ByVal ExcelBookPath As String, ByVal SheetName As String, ByVal LinkedSheetName As String) As Boolean
    On Error GoTo EXCEPTION
    Dim DB As Database
    Dim tblExcel As TableDef
    LinkExcelDAO_ADD = False
    Set DB = CurrentDb
    Set tblExcel = DB.CreateTableDef(LinkedSheetName)
 
    ‘EXCELのファイル名とシート名を指定(リンクモード、１行目をヘッダとする)
    tblExcel.Connect = "excel 8.0;;HDR=YES;IMEX=2;DATABASE=" & ExcelBookPath
    tblExcel.SourceTableName = SheetName & "$"
    DB.TableDefs.Append tblExcel
   
    ‘成功
    LinkExcelDAO_ADD = True
FINALLY:
    DB.TableDefs.Refresh
    Application.RefreshDatabaseWindow
    Set tblExcel = Nothing
    Set DB = Nothing
    Exit Function

EXCEPTION:
   Resume FINALLY

End Function

‘リンクの削除
Private Function LinkExcelDAO_DEL(ByVal LinkedSheetName As String) As Boolean
    On Error GoTo EXCEPTION
   
    Dim DB As Database
    LinkExcelDAO_DEL = False
    Set DB = CurrentDb
    Call DB.TableDefs.Delete(LinkedSheetName)
    ‘成功
    LinkExcelDAO_DEL = True

FINALLY:
    DB.TableDefs.Refresh
    Application.RefreshDatabaseWindow
    Set DB = Nothing
    Exit Function

EXCEPTION:
   Resume FINALLY
End Function

‘リンクの変更（削除→新規）
Private Function LinkExcelDAO_MOD(ByVal Path As String, ByVal SheetName As String, ByVal LinkedSheetName As String) As Boolean
    LinkExcelDAO_MOD = False
    If LinkExcelDAO_DEL(LinkedSheetName) = True Then
        If LinkExcelDAO_ADD(Path, SheetName, LinkedSheetName) = True Then
            LinkExcelDAO_MOD = True
        End If
    End If
End Function

‘リンクの設定確認（一覧、デバッグ用）
Private Sub LinkExcelDAO_CHK()
  Dim DB As Database
  Dim tblExcel As TableDef
      
  Set DB = CurrentDb
  For Each tblExcel In DB.TableDefs
           Debug.Print "Name:" & tblExcel.name & vbTab & "Connect:" & tblExcel.Connect
  Next tblExcel
  Set tblExcel = Nothing
  Set DB = Nothing
 
End Sub