Workbook_OpenイベントでMDBファイルが見つからない場合、新規にデータベースファイルを作成し、自社情報テーブルを作成します。
1） CreateDatabase でデータベースを作成します。
2） CreateField でフィールドを作成します。
作成するフィールドは下記にしました。
・ 自社名 テキスト型 30文字
・ 郵便番号 テキスト型 20文字
・ 住所1 テキスト型 50文字
・ 住所2 テキスト型 50文字
・ TEL テキスト型 30文字
・ FAX テキスト型 30文字
・ 振込先 テキスト型 50文字
■ThisWorkbookイベント
Option Explicit
'ブックが開いた時のイベント
Private Sub Workbook_Open()
'このExcelファイルがあるフォルダー
sExcelPath = ActiveWorkbook.Path
'末にパスが付いているかどうか
If Right(sExcelPath, 1) <> "\" Then
'パスを付ける
sExcelPath = sExcelPath + "\"
End If
'データファイルの存在確認
If ExFileExist(sExcelPath + "hanbai2009.mdb", vbNormal) = "" Then
'MsgBox "ここに、MDBファイルの新規作成処理を記入します。"
MyMakeDataBase
End If
End Sub
■データベース作成プロシージャ
Private Sub MyMakeDataBase()
Dim db As Database
Dim bRet As Boolean
' データベース作成
Set db = DBEngine.Workspaces(0).CreateDatabase(sExcelPath + "hanbai2009.mdb", dbLangJapanese)
bRet = MyMakeJisyajyouhou(db)
Set db = Nothing
End Sub
■フィールド作成プロシージャ
Private Function MyMakeJisyajyouhou(tdb As Database) As Boolean
Dim tbdef As TableDef
Dim fld As Field
On Error GoTo ErrExit
'テーブル作成
Set tbdef = tdb.CreateTableDef("T_自社情報")
'フィールド作成
Set fld = tbdef.CreateField("自社名", dbText, 30)
tbdef.Fields.Append fld
Set fld = tbdef.CreateField("郵便番号", dbText, 20)
tbdef.Fields.Append fld
Set fld = tbdef.CreateField("住所1", dbText, 50)
tbdef.Fields.Append fld
Set fld = tbdef.CreateField("住所2", dbText, 50)
tbdef.Fields.Append fld
Set fld = tbdef.CreateField("TEL", dbText, 30)
tbdef.Fields.Append fld
Set fld = tbdef.CreateField("FAX", dbText, 30)
tbdef.Fields.Append fld
Set fld = tbdef.CreateField("振込先", dbText, 50)
tbdef.Fields.Append fld
tdb.TableDefs.Append tbdef
'終了処理
Set fld = Nothing
Set tbdef = Nothing
MyMakeJisyajyouhou = True
Exit Function
ErrExit:
MyMakeJisyajyouhou = False
MsgBox "自社情報テーブル作成中にエラーが発生しました。処理を中止します。" & vbNewLine & Err.Description
End Function