すごいコードから着想を得る
Accessなしでデータベースを作成する。
というものすごい天才的なコードが示されているのですが、ふと思いました。
「これを使うとEXCEL 2016 64bit」でもEXCELからMDBファイルが作れるのでは!?
今のところバグが出ますが、できないことはないようです。
環境
Office 2016 64bit (Access 2010 ODBCドライバ入り)+ Win10 Home
参照設定
Microsoft ADO Ext 2.x for DDL and Security
Microsoft Active Data Objects 2.x Library
これを設定するということはそれ以外の6.0とかは外さないとエラーになります。
そして、これがHPにないのですが、
Microsoft Jet and Replication Object 2.6 Libraly
を加えます。
前提
上記のHPは設定表シートがあり、いくつかのシートからテーブルを作り、テーブルごとに主キーを加えるというむちゃくちゃなものです。
これでは実験する前に心がおれてしまいます。
そこで、Listというシートを作り、全部長整数型の数字(小数点がない)
ものを作ります。
Gapは差なのですが、式は入っていません。ここはVBAで計算して差を値だけ入れるためです。
なんでそんなことをしているかというと、13000行を超えているので計算式を入れていると遅くなるからです。
ここはsqlを作成する場合0を補う必要があります。
そして、HPにもあるように該当するエクセルファイルのあるフォルダにDBというフォルダを作り、sample.mdbというファイルを作ります。既存のファイルがあれば、それを削除します。
宣言部分
ここで重要なのは
AccessVBA、ADOXでmdb作成
より
Const cnsConnect1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
を
Const cnsConnect1 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
に書き換えます。
これにともないcnsConnect2が不要になります。
バージョンがあがってMDBが扱えなくなったはずなのに・・・
あと当方は64ビットなので
Private Declare PtrSafe Function GetPrivateProfileString Lib
とPrtSafeが加わっています
Const cnsTitle = "MDBの作成(ADOX)"
Const cnsMDB_FILE = "\SAMPLE.mdb"
'///////////////
Const cnsConnect1 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
'///////////////
'Const cnsConnect2 = ";Jet OLEDB:Engine Type=5;"
Const cnsSH0 = "設定"
Const cnsSH1 = "テーブル"
Type typKey
KeyName As String
KeyIdx As Integer
End Type
'■iniファイル読込み(String)
Private Declare PtrSafe Function GetPrivateProfileString Lib "KERNEL32.dll" _
Alias "GetPrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long
Sub
Sub MAKE_MDB()
Dim xlApp As Application
Dim WBK As Workbook
Dim SH As Worksheet
Dim dbCat As ADOX.Catalog
Dim dbTbl As ADOX.Table
Dim dbKey As ADOX.Key
Dim dbCon As ADODB.Connection
Dim strDB_Path As String ' MDBの収容フォルダ
Dim strMDB As String ' MDBの物理ファイル名
Dim strConnect As String
Dim GYO As Long
Dim GYO1 As Long
Dim GYO2 As Long
Dim COL As Long
Dim COL2 As Long
Dim wrkKey As typKey
Dim strSQL As String
Dim strSQL1 As String
Set xlApp = Application
Set WBK = ActiveWorkbook
Set SH = WBK.Worksheets("List")
strDB_Path = FP_GET_INI_String("F-1", "DBPATH", WBK.Path & "\DB", _
WBK.Path & "\F-1.ini")
' DBフォルダがなければ作成
If Dir(strDB_Path, vbDirectory) = "" Then MkDir strDB_Path
' MDBは本ブックのフォルダの配下にある「DB」フォルダに作成
strMDB = strDB_Path & cnsMDB_FILE
If Dir(strMDB, vbNormal) <> "" Then
' MDBから新規作成するので、既にある場合は一旦削除
If MsgBox(strMDB & vbCr & _
"は既に存在しているので一旦削除して再生成します。" & vbCr & vbCr & _
"よろしいですね?", _
vbInformation + vbYesNo, cnsTitle) <> vbYes Then Exit Sub
xlApp.DisplayAlerts = False
Kill strMDB
xlApp.DisplayAlerts = True
End If
strConnect = cnsConnect1 & strMDB '& cnsConnect2
Set dbCat = New ADOX.Catalog
' Access2000形式のMDBファイルを新規作成
dbCat.Create strConnect ' ①
DoEvents
' 作成したMDBに接続
dbCat.ActiveConnection = strConnect
GYO = 1
GYO1 = GYO
' テーブルを作成する
Set dbTbl = New ADOX.Table
Set dbKey = New ADOX.Key
cntKey = 0
dbTbl.Name = "List" ' テーブル名
' フィールドの登録
Do While GYO < 5
' フィールドを追加
dbTbl.Columns.Append SH.Cells(1, GYO).Value, dbLong ' ④
GYO = GYO + 1
Loop
dbCat.Tables.Append dbTbl ' ⑧
' オブジェクト変数の解放
Set dbKey = Nothing
Set dbTbl = Nothing
Set dbCat = Nothing
'-------------------------------------------------------------------------------
' ■テーブルのレコードの入力
Set dbCon = New ADODB.Connection
dbCon.Open strConnect
If ((SH.Name <> cnsSH0) And (SH.Name <> cnsSH1)) Then
' 最終行列の判定
With SH.Cells.SpecialCells(xlCellTypeLastCell)
GYO2 = .Row
COL2 = .Column
End With
' 最終行まで繰り返す
GYO = 2
strSQL1 = "INSERT INTO " & SH.Name & " VALUES("
Do While GYO <= GYO2
' SQLの作成INSERT文を作成
strSQL = strSQL1
For COL = 1 To 4
If SH.Cells(GYO, COL).Value <> "" Then
' Make Sql string with Padding 0
If COL <> 1 Then strSQL = strSQL & "," & SH.Cells(GYO, COL).Value: Debug.Print strSQL, COL, GYO Else strSQL = strSQL & SH.Cells(GYO, COL).Value
Else
If COL <> 1 Then strSQL = strSQL & "," & "0": Debug.Print strSQL, COL, GYO Else strSQL = strSQL & "0"
End If
Next COL
strSQL = strSQL & ");"
dbCon.Execute strSQL ' INSERT文を実行
GYO = GYO + 1
Loop
End If
dbCon.Close
Set dbCon = Nothing
WBK.Saved = True
MsgBox "MDBの作成が完了しました。", vbInformation, cnsTitle
End Sub
このあとは
Private Function FP_GET_INI_String
が必要になりますが、それは冒頭の参考サイトをご覧ください。
解説の〇つき数字は元のHPのプログラムと同じです。
サブプロシージャも感心はされない方もいらっしゃると思いますが、このままでは高度過ぎて誰も理解できないまま埋もれてしまうので、シンプルな設定から変換するようにしました。また表現を変えて少しわかりやすい注記に変えました。でも過程を途中で切るとわけがわからないので、こんな長くなってしまいます。閉鎖したサイトのように検索よけとかじゃないよ。
正直できるとは思わなかった。
プログラムの流れ
このサブプロシージャはフォルダを作る、ファイルを作る、テーブルを作る、データを流し込む、という流れでできています。元のプログラムがすごいのは設定表シートをもとに複数のシートからテーブルを作成するところでしょう。たしかにMDBのテーブルは今でもEXCEL2016からできてしまうのです。ということはaccdbのファイルも作れるのかもしれません。
元のファイルは日付形式は日付リテラルで挟むようにSELECT文を打つなど細かい配慮に満ち溢れていますが、今回はできるかどうかだけなので、こんなシンプルなものです。すいません。
残された謎
ところで本当はかっこよく倍精度にしたかったのですが、dbDoubleにするとなぜか数字が日付になってしまうので、なくなくdbLongにしました。データの型式によっては作れないのもあるのかもしれません。
しかしさらにわけがわからないのはこうやって作ったmdbファイル、access2016 64bitで開けるんです。しかもテーブルの設定が変えられるんです。
さらにMicrosoft OLE DB Provider for Microsoft Jet はOffice 2013 Laterで現役なのです。
日本語のmdbからaccdbに変換できることは以前書きました。
ということは、Office2016でもmdbファイルもテーブルくらいならそこそこ扱えるみたいなのです。
補足
cnsConnect2の意味は
DAO から ADO への移植11
にあります。