Accessテーブルの存在確認

  ''Excel用
  Dim cn As Object: Set cn = CreateObject("ADODB.Connection")
  Dim ct As Object: Set ct = CreateObject("ADOX.Catalog")
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\作業用.mdb" & ";"
      ct.ActiveConnection = cn
      Dim tb As Object: Dim TableExists As Boolean
      For Each tb In ct.Tables
        If (tb.Type = "TABLE") And (tb.Name = "完了検査") Then
          TableExists = True
          Exit For
        End If
      Next tb
      If TableExists <> True Then cn.Execute "CREATE TABLE 完了検査 (id LONG CONSTRAINT PrimaryKey PRIMARY KEY, 検査済証番号文字 TEXT(32), 年号和 TEXT(2), 年号英 TEXT(1), 年 INT, 検査済証番号数字 LONG, 検査日 DATE, 元確認番号 LONG, 確認日 DATE);"
    cn.Close: Set cn = Nothing: Set ct = Nothing
  ''Access用
  If TableExist("帳票テーブル1") = True Then DoCmd.RunSQL "DROP TABLE 帳票テーブル1;"
  
  Private Function TableExist(MyTableName As String) As Boolean
    Dim rs As Object: Set rs = CurrentDb.OpenRecordset("SELECT Name FROM MsysObjects WHERE Left([Name],4) <> 'Msys' AND Type = 1 ORDER BY Name;")
  
    TableExist = False
    Do Until rs.EOF
      If MyTableName = rs.Fields(0) Then
        TableExist = True
        Exit Do
      End If
      rs.MoveNext
    Loop
  
    rs.Close: Set rs = Nothing
  End Function

コメント

タイトルとURLをコピーしました