[VBA SQL]Access のテーブルとExcelのxlsx形式ファイルでImport Exportを行う方法 How to Import And Export between Accss Table To xlsx Worksheet

1.前回の記事とあわせて

Access SQL Access>>Excel Select INTO で テーブル クエリをxlsbに出力する Access Query Can Export xlsb file from Table or Query With Acrion Query Select Into
このときはExcelへの出力しかできなかった。今回はまとめて行きます。

2.大半のブログや記事が間違っていること

2-1.根拠はここ

Microsoft Access データベース エンジン 2016 再頒布可能コンポーネント

Access データベース エンジン 2016 再頒布可能コンポーネントを以下の目的で使用することはできません。

1. Jet の全面的な代替としての使用 (Jet の全面的な代替が必要な場合は、SQL Server Express Edition が必要です)。
2. サーバー側アプリケーション内での Jet OLEDB プロバイダーとしての使用。
3. 一般的なワード プロセッサ、スプレッドシート、データベース管理システムとしての使用 (つまり、ファイル作成の手段としての使用)。(Microsoft Office でサポートされているファイルは、Microsoft Office または Office Automation を使用して作成できます)。
4. システム サービスまたはサーバー側プログラム (コードがシステム アカウントの下で実行されるもの、複数のユーザー ID を同時に処理するもの、高度に再入可能で動作が不安定になるもの) による使用。これには、ユーザーがログインしていないときにタスク スケジューラーから実行されるプログラムや、ASP.NET などのサーバー側 Web アプリケーションから呼び出されるプログラム、COM+ サービスの元で実行される分散コンポーネントなどがあります。

使用方法:

アプリケーションのユーザー: 適切なドライバーを使用する方法の詳細については、アプリケーションの説明書を参照してください。
OLEDB を使用するアプリケーション開発者: ConnectionString プロパティのプロバイダー引数を "Microsoft.ACE.OLEDB.12.0" に設定します。
Microsoft Office Excel データに接続する場合は、Excel ファイルの種類に基づいて OLEDB 接続文字列の適切な拡張プロパティを追加します。

ファイルの種類 (拡張子)                            拡張プロパティ
-----------------------------------------------------------------
Excel 97-2003 ブック (.xls)                      "Excel 8.0"
Excel ブック (.xlsx)                             "Excel 12.0 Xml"
Excel マクロ有効ブック (.xlsm)                    "Excel 12.0 Macro"
Excel XML 以外のバイナリ ブック (.xlsb)            "Excel 12.0"

2-2.xlxsファイルはExcel 12.0 Xml;

つまり、xlsxはExcel 12.0 Xmlと書くべきなのである。
しかし、これは以前はここになかったと思う。

2-3.ただし、Excel 12.0;でも動く

EXCELでEXCELファイルおよびACCESSのデータに対してSQLを実行する方法
ここでも参考になることが多いが、やはり12.0、ExcelWorkInfoもそう。多くのサイトで問題なく紹介されている。

3.前提

3-1.ファイルはすべて同じフォルダにある

Accdbファイル、出力するExcel、インポートするエクセルファイルとも同じフォルダにある。
このとき、既定のフォルダ（標準では%USERPOFILE%\Documents)またはその下位のフォルダにある場合、フルパスで書く必要がない。
しかし今回はC:\hoge\にあるものとする。

3-2.Table

Access VBA 2つのテーブルのインデックス等が同じレコード同士のフィールドを比較し、違う値のフィールドをみつける
To Find Different value on Field Which Tables has same index, same data type field
のものを使います。
T2021とします。

口座番号	金額	面積	注釈	注釈ST
2	¥4,500	12.45	平成5年度購入　金額は推定	短い改行2
3	¥5,000	6.223	3桁の数	
4	¥8,000	10000.2		
5	¥60,000	122	新規の	新規の２

3-3.File

Exportするファイルはxlsx形式で
TableExport.xlsx
とします。このファイルは現在フォルダに存在しません。
存在するとエラーになります。
インポートするファイルは
IMportTable.xlsx
とします。

3-3.クエリ名

AQ_TabletoXlsx
AQ_ImportXlsx

4.インポート

4-1.SQL

SELECT [T2021].* INTO [Excel 12.0 xml;ReadOnly=False;HDR=YES;IMEX=0;DATABASE=C:\hoge\TableExport.xlsx].Sheet1
FROM [T2021];

このようになります。既定のフォルダであれば

SELECT [T2021].* INTO [Excel 12.0 xml;ReadOnly=False;HDR=YES;IMEX=0;DATABASE=.\TableExport.xlsx].Sheet1
FROM [T2021];

とかけます。

4-2.クエリを開いて修正できない

このクエリは開くとめちゃくちゃになり、動作が不安定になります。このため、VBAで作り、実行します。
同時に実行しないとクエリが完成したあとダブルクリック等によりクエリを実行すると、不具合が起きる時があるからです。
Shet1のままであれば良いのですが、シート名を変更した場合はエラーになりやすいです。
また、VBAを作りますので、AccessのSQLやアクションマクロではできない、既存のxlsxファイルも削除も行います。

4-3.VBA

少し、一般化し、ステップごとに確認するようにしてあります。
FSOは参照設定する必要があります。

Make_AQ_ExportXlsx

Sub Make_AQ_ExportXlsx()
' For Access
' Microsoft Scripting Runtimeを参照設定してください。
Dim cDB As dao.Database: Set cDB = CurrentDb
Dim bl As Boolean
Dim fso As New Scripting.FileSystemObject, sPath As String, sFile As String
Const TgFile = "TabeleExport.xlsx" ' エクスポートするxlsxファイル名。同名のファイルが有ればエラーになる。
Const TgTbl = "T2021" ' エクスポート（出力）するテーブル名
Const TgQr = "AQ_TblExportXlsx"
sPath = CurrentProject.Path
CreateObject("WScript.Shell").CurrentDirectory = sPath
' ここでテーブルとクエリを閉じるSubプロシージャを呼び出すのが望ましい
If fso.FileExists(fso.BuildPath(sPath, TgFile)) = True Then
If MsgBox("同名のファイル" & TgFile & "があります。削除しますか？キャンセルで無変更終了します", vbOKCancel, "同名のファイルの削除") = vbCancel Then
Exit Sub
End If
End If
bl = False
Dim tdf As TableDef, Q As QueryDef
For Each tdf In cDB.TableDefs
If tdf.Name = TgTbl Then bl = True: Exit For
Next
If bl = False Then MsgBox "指定されたtgtbl = " & TgTbl & "がないので処理を終了します", vbOKOnly + vbCritical, "エラー：指定されたテーブルがない": Exit Sub
bl = False
For Each Q In cDB.QueryDefs
If Q.Name = TgQr Then bl = True: Exit For
Next
If bl = True Then
If MsgBox("同名のクエリ" & TgQr & "があります。OKで削除して作り直し、キャンセルで終了します", vbOKCancel, "確認：同名のクエリの削除") = vbCancel Then
Exit Sub
Else
DoCmd.DeleteObject acQuery, TgQr
End If
End If
Set Q = cDB.CreateQueryDef(TgQr, "Select " & TgTbl & ".* Into [Excel 12.0 xml;ReadOnly=False;HDR=YES;IMEX=0;DATABASE=" & fso.BuildPath(sPath, TgFile) & "].Sheet1 from " & TgTbl & ";")
Application.RefreshDatabaseWindow
Q.Execute ’ ここで実行する
End Sub

4-4.ここから応用

いままでもこうしたのをやってきましたが例えば、シート名を変えたり(Sheet1=>Sheet11) レコードを絞ったり、、フィールドを絞ったりできるのでしょうか。
結論から言うとできます。

4-5.クエリ名

AQ_TabletoXlsx2

4-6.SQL

SELECT T2020.口座番号, T2020.金額 INTO (Excel 12.0 xml;ReadOnly=False;HDR=YES;IMEX=0;DATABASE=C:\hoge\TableExport.xlsx) Sheet11
FROM T2020
WHERE (((T2020.口座番号)=2));

このように開くとおかしくなっています。

SELECT [T2020].口座番号, [T2020].金額
INTO [Excel 12.0 xml;ReadOnly=False;HDR=YES;IMEX=0;DATABASE=C:\hoge\TableExport.xlsx].Sheet11
FROM [T2020]
WHERE [T2020].口座番号=2;

ただし、時々 すでにSheet1が存在しますというエラーが出るときがあるので、上記のように Q.Executeで実行します。
こうするとエラーが起きません。
Sheet名はSheet11となり、1行だけ、しかも2列だけが出力されます。

4-6-1.ポイント

• Schema.iniは生じない
• 出力するファイルと同名のファイルがあるとエラーになる。
• 拡張子xlsxに合わせて`Excel 12.0 Xml`を配置。
• 少しでも間違ったり、空白が多い、空白が全角といったことでエラーになるので、正確に書く。
• `xlsx].Sheet11`の部分は`xlsx]!Sheet11`のように書くとエラーになる。このためエクスクラメーションマークは使わない。
• テーブルに空白がある場合は角カッコ、ファイル名に空白がある場合はシングルクォーテーションで囲む

4-7.VBA 使いまわし

Sub Make_AQ_ExportXlsx2()
Dim cDB As dao.Database: Set cDB = CurrentDb
Dim bl As Boolean
Dim fso As New Scripting.FileSystemObject, sPath As String, sFile As String
Dim sSQL As String
Const TgFile = "TableExport.xlsx" ' エクスポートするxlsxファイル名。同名のファイルが有ればエラーになる。
Const TgTbl = "T2020" ' エクスポート（出力）するテーブル名
Const TgQr = "AQ_TblExportXlsx2"
sPath = CurrentProject.Path
CreateObject("WScript.Shell").CurrentDirectory = sPath
If fso.FileExists(fso.BuildPath(sPath, TgFile)) = True Then
If MsgBox("同名のファイル" & TgFile & "があります。削除しますか？キャンセルで無変更終了します", vbOKCancel, "同名のファイルの削除") = vbCancel Then
Exit Sub
End If
End If
bl = False
Dim tdf As TableDef, Q As QueryDef
For Each tdf In cDB.TableDefs
If tdf.Name = TgTbl Then bl = True: Exit For
Next
If bl = False Then MsgBox "指定されたtgtbl = " & TgTbl & "がないので処理を終了します", vbOKOnly + vbCritical, "エラー：指定されたテーブルがない": Exit Sub
bl = False
For Each Q In cDB.QueryDefs
If Q.Name = TgQr Then bl = True: Exit For
Next
If bl = True Then
If MsgBox("同名のクエリ" & TgQr & "があります。OKで削除して作り直し、キャンセルで終了します", vbOKCancel, "確認：同名のクエリの削除") = vbCancel Then
Exit Sub
Else
DoCmd.DeleteObject acQuery, TgQr
End If
End If
sSQL = "SELECT [" & TgTbl & "].口座番号, [" & TgTbl & "].金額 INTO [Excel 12.0 xml;ReadOnly=False;HDR=YES;IMEX=0;DATABASE=" & fso.BuildPath(sPath, TgFile) & "].Sheet11" & vbCrLf & _
"FROM " & TgTbl & vbCrLf & _
"WHERE [" & TgTbl & "].[口座番号]=2;" ’ ここが書き換わっている
Set Q = cDB.CreateQueryDef(TgQr, sSQL)
Application.RefreshDatabaseWindow 
Q.Execute ' このまま実行
End Sub

このように汎用性の高いコードです。

5.Export

5-1.ロケール

日本語環境とします

5-2.出力するテーブル

T20223
毎回作成し直されます。
また、
表はちょっとかわります

ID	金額	金額2	面積	DT日付	DT日付2	sHyper	注釈	注釈ST	F08	F09
1	¥4,500 	¥45 	12.450	'S21/5/1	1946/5/1	https://www.google.co.jp	購入　推定	hYperLink	-1	TRUE
2	¥5,000 	¥45 	6.223	'S21/5/1	1946/5/1	https://www.google.co.jp	3桁の数修正可能		0	FALSE
3	¥8,000 	¥45 	1,000	'S21/5/1	1946/5/1	https://www.google.co.jp	NOは文字列		-1	TRUE
4	¥8,000 	¥45 	122.000	'S21/5/1	1946/5/1	https://www.google.co.jp	新規の	新規の２	0	FALSE

金額2は=45*1という数式が入っていますが、この列の表示形式は金額の列と同じく、通貨になっています。
DT日付2はアポストロフが入っています。
通貨記号は必ず明示してください

5-2.SQL

SELECT *
INTO T20223
FROM (SELECT * FROM [Excel 12.0 Xml;HDR=YES;IMEX=0;DATABASE=C:\hoge\IMportTable.xlsx].[Sheet1$]);

5-2-1.クエリのポイント

• サブクエリ。`(SELECT * FROM ...);`のところがサブクエリで、カッコで囲んでいます。
• `[Sheet1$]`ここが一番ハマったところで、Exportと異なり、必ず`[]`で囲みます。
• Excelファイルの場合、このように指定することで、サブクエリをかけてテーブルとみなされるようになります。
• Excel 12.0 xlsb Excel 12.0 Xml xlsx Excel 12.0 Macroと拡張子との対応関係注意
• HDR=YESと言うのはヘッダー付きという意味です。
• IMEX=0はある程度データ型を判定してからテーブルに変換するという意味になります。

5-3変換後

T20223
ID 倍精度浮動小数点型
金額 通貨型
金額2 通貨型
DT日付 短いテキスト
DT日付2 日付時刻型
sHyper 短いテキスト
F08 倍精度浮動小数点型
F09 Yes/No型

5-3-1.変換後のテーブルのデータ型のポイント

5-3-1-1.ID列は主キーにならない

名前で自動的にインデクスになる効果があるときがあるが、それはきかない。
この列を主キーにするには

1. 長整数型に変えてインデックス（重複なし）にする。このときデータ喪失の警告が出るが、無視。無視して保存する。
2. 主キーを指定して保存する。

5-3-1-2.長整数型にはならない

小数点以下が存在するかしないかに関わらずすべて倍精度浮動小数点型になってしまう。

5-3-1-3.ハイパーリンク型にならない

文字列型かメモ型になる。

5-3-1-4.文字列型は強制できる

完全ではないと思われるが、アポストロフ（シングルクォーテーション）をつけるとテキスト型かメモ型になる。

5-3-1-5.日付型は日付になっていればOK

自動的に解釈される。

5-3-1-6.表示形式で通貨記号さえつけていれば通貨型になる

表示形式で通貨記号をつける。日本語環境だと¥をつければよい。ただしドル記号も&Yen;に変換されるので、結果的に¥だけしか通貨型にならない。

5-3-1-7　True　FalseだとYesNo型になる

また、True -1 False 0 なので、-1 と 0を入れておけばあとから変換できる。
また、Yes NoではYesNo型にならない。

5-4.Excelでもデータ型の指定がある程度できる

以上の検討から、次のように言える。
短いテキスト型 シングルクォーテーションで強制指定可能。
長いテキスト型 255文字を超えると強制
日付時刻型　　 日時になっていれば可能
通貨型 表示形式を通貨にして通貨記号を表示させていれば可能
YesNo型 True、Falseにしておくと可能
数字 Double 倍精度浮動小数点型になる

ハイパーリンク、長整数型、オートナンバー型、Integer、Decimal、Byteは直接指定できない。
Schema.Iniがないため細かい指定ができないが、ある程度この自動的に指定されることを利用すれば基本的な不自由はない。
ただし倍精度なので、演算誤差が発生する可能性がある。
正確に入れるためには一旦テキスト型を強制して、桁数を確認して変換する。変換したあと四捨五入した値と比較する。
整数なら演算誤差は起きないため、整数と小数点以下に列を分割する。あとから計算で合成する。
a = 100 b=11 bは2桁なので $10^{2}=100$

$INT(100*100+11+0.5)/100$

このように演算誤差がおきないようにするか（上記は15桁まで。また、正の数限定）

$CDec(100+(Cdec(11/100))$

ただし、クエリ式ではこのようにかけないので、VBAでユーザー定義関数を作る。

5-5.公式のExcelへのCSVインポートの解説

テキスト インポート ウィザード
テキスト (.txt または .csv) ファイルのインポートまたはエクスポート

注: 最大で 1,048,576 行、16,384 列をインポートまたはエクスポートすることができます。

文字列として保存されている数値を数値形式に変換する
文字列形式の日付を日付形式に変換する
数式を計算値に置き換える

5-5.ACE.OLEDBとかJetは不要

[Microsoft.ACE.OLEDB.12.0;HDR=YES;IMEX=0;DATABASE=C:\hoge\IMportTable.xlsx].[Sheet1$]);
という書き方はエラー。

5-6.Persist Security Info=False; Trusted_Connection=False は必要がないけど有効

接続文字列(SQLServer)
JetやAceの接続文字列を見ると、こうしたものも入っている。
つまり、出だしのAceを書けばエラーだが、その後ろの接続文字列は実際はフルで入ってくる。

5-7.Imex=0

IMEX=1にしても、Accessがデータ・タイプの判定ができた場合にはデータ型はテキスト型にならない。通常はデータ型を固めているのでImex=0を使う。通常はImex=0

5-8.VBA

これも似ている。本来はテーブルは削除しなくてもSelect Intoのときに削除されるが、自動実行するときになぜかエラーが起きるので、このなかでテーブルを削ることにした。テーブルを削除しない場合はクエリをダブルクリック等により実行して削除して新しいものが作られる。

Sub Make_AQ_ImportXlsx()
' For Access
' Microsoft Scripting Runtimeを参照設定してください。
Dim cDB As dao.Database: Set cDB = CurrentDb
Dim bl As Boolean
Dim fso As New Scripting.FileSystemObject, sPath As String, sFile As String
Dim sSQL As String
Const TgFile = "IMportTable.xlsx" ' インポートするxlsxファイル名。ファイルがなければエラーになる。
Const TgTbl = "T20223" ' テーブル名
Const TgQr = "AQ_TblImportXlsx" ' クエリ名
sPath = CurrentProject.Path
CreateObject("WScript.Shell").CurrentDirectory = sPath
If fso.FileExists(fso.BuildPath(sPath, TgFile)) = False Then
 MsgBox "同名のファイル" & TgFile & "がありせん。終了します", vbOKOnly + vbCritical, "エラー：指定されたファイルがない"
 Exit Sub
End If
bl = False
Dim tdf As TableDef, Q As QueryDef
bl = False
' クエリのチェック
bl = False
For Each Q In cDB.QueryDefs
If Q.Name = TgQr Then bl = True: Exit For
Next
If bl = True Then
If MsgBox("同名のクエリ" & TgQr & "があります。OKで削除して作り直します", vbOKCancel, "確認：同名のクエリの削除") = vbCancel Then
Exit Sub
Else
DoCmd.DeleteObject acQuery, TgQr
sSQL = "SELECT *" & vbCrLf & _
"INTO " & tgtbl & vbCrLf & _
"FROM (SELECT * FROM [Excel 12.0 Xml;HDR=YES;IMEX=0;DATABASE=" & fso.BuildPath(sPath, TgFile) & "].[Sheet1$]);"
Set Q = cDB.CreateQueryDef(TgQr, sSQL)
Application.RefreshDatabaseWindow
End If
End If
' テーブルのチェック
For Each tdf In cDB.TableDefs
If tdf.Name = TgTbl Then bl = True: Exit For
Next
If bl = True Then
  If MsgBox("同名のテーブル" & TgTbl & "があります。OKで削除します、キャンセルで削除しません", vbOKCancel, "確認：同名のテーブルの削除") = vbOK Then
  DoCmd.DeleteObject acTable, TgTbl
  bl = False
  Else
  bl = True
  End If
End If


If bl = False Then
Q.Execute ' テーブルがあるときはこれで実行するとエラーになるので、同意があれば前段で作成するテーブルを削っている。
End If

End Sub

6.今回はここまで

以上のようにSQLでAccessとExcelはやりとりが相互にできる。
あとはデータが隙間なく詰まっていることが望ましい。