ACCESS VBA ACCESS SQL Select.Intoの裏技テーブルの列分割、エクスポート、空複写 Copy ,Only Table Distrution Copy,Field Split

コード

Dドライブのルートを使っています

変更するときは、
Const Dnm = "D:\"
適当に変えてください
またMDBを使っていますので、
DbS.MDB,DbsG.MDB
です
Dim strMDB :strMDB = Dnm & "\DbS.MDB"
Dim stgMDB:stgMDB= Dnm & "\DbsG.MDB"
都合が悪い場合、変更してください。
この場合ファイルチェックの部分も併せてかえてください
if .FileExists(Dnm & "\DbS.MDB") Then .DeleteFile(Dnm & "\DbS.MDB")
if .FileExists(Dnm & "\DBsG.MDB") Then .DeleteFile(Dnm & "\DBsG.MDB")

Option Explicit
'32bit 強制起動
'http://scripting.cocolog-nifty.com/blog/2011/02/wsh6432bit-b32d.html

If InStr(LCase(WScript.FullName),"system32") Then 
If CreateObject("Scripting.FileSystemObject").FileExists(Replace(LCase(WScript.FullName),"system32","syswow64")) Then
  CreateObject("WScript.Shell").Run """" & Replace(LCase(WScript.FullName),"system32","syswow64") & """ """ & WScript.ScriptFullName & """"
  WScript.Quit
End If
End If

Const Dnm = "D:\"
Const dbVersion30 =32
Const dbVersion40 =64
'LanguageConstants 列挙 (DAO)(https://msdn.microsoft.com/ja-jp/library/office/ff821047.aspx)
Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0" '英語、ドイツ語、フランス語、ポルトガル語、イタリア語、および現代スペイン語
Const dbLangJapanese = ";LANGID=0x0411;CP=932;COUNTRY=0"
With CreateObject("Scripting.Filesystemobject")
Dim strMDB :strMDB = Dnm & "\DbS.MDB"
Dim stgMDB:stgMDB= Dnm & "\DbsG.MDB"
if .FileExists(Dnm & "\DbS.MDB") Then .DeleteFile(Dnm & "\DbS.MDB")
if .FileExists(Dnm & "\DBsG.MDB") Then .DeleteFile(Dnm & "\DBsG.MDB")
end with
Dim dbe :set dbe = CreateObject("DAO.DBEngine.36") 
Dim cDb : set cDb =dbe.CreateDatabase(Dnm & "\DbScr.MDB",dbLangJapanese,dbVersion40)
Dim wrk :set wrk= dbe.workspaces(0)
Dim Db1 : set Db1= wrk.CreateDatabase(Dnm & "\DbsG.MDB",dbLangJapanese,dbVersion40)
cdb.Execute("Create Table T_Master(ID Counter Primary Key, F1Staff Text(255),F2Sale Currency);")
Dim tdf : set tdf = Cdb.Tabledefs("T_Master")
Dim Rs :set Rs = cdb.OpenRecordSet(tdf.name)
rs.addnew
Rs.Fields(1) = "Mike"
Rs.Fields(2) = 1000
rs.update
rs.addnew
Rs.Fields(1) = "Nick"
Rs.Fields(2) = 2000
rs.update
rs.close
Db1.Execute("Create Table T_MasterTg(ID Counter Primary Key, F1Customer Text(255),F2Payment Currency);")
Db1.Tabledefs.Refresh
Dim tdf2:Set tdf2 = Db1.TableDefs("T_MasterTg")
'wrk.Databases.Refresh
cdb.TableDefs.Refresh
Db1.TableDefs.Refresh

set Rs = Db1.OpenRecordSet("T_MasterTg")
rs.addnew
Rs.Fields(1) = "Tarou"
Rs.Fields(2) = 2540
rs.update
rs.addnew
Rs.Fields(1) = "Ichirou"
Rs.Fields(2) = 3854
rs.update
rs.close
'Db1の T_MasterTg をCDBにそのままコピーする
wrk.Databases(0).Execute ("Select [T_MasterTG].* INTO [T_MasterBuyer] FROM [T_MasterTG] In """ & stgMDB & """;")
'空集合(該当するレコードが一つもない選択クエリ)のクエリを作ってテーブルの構造の主な部分をコピーする ’From 以降は()で閉じないとエラーになる
cdb.Execute ("Select * INTO [T_MasCopy] From (SELECT * FROM [T_Master] WHERE (((T_Master.[F1Staff]) Like ""*ANONYMOUS*"")));") 

'テーブルを分割 IDと F1staff ID と F2Sake
cdb.Execute ("Select * INTO [T_Mas2] From (SELECT [ID],[F1Staff] FROM [T_Master] WHERE (((T_Master.[F1Staff]) Like ""*ANONYMOUS*"")));") 
cdb.Execute ("Select * INTO [T_Mas3] From (Select [T_Master].ID,[T_Master].F2Sale From [T_Master]);") 
'外部データベースへテーブルをコピーする
cdb.Execute ("Select [T_Master].* INTO [T_Master] In """ & stgMDB & """ FROM [T_Master];")

on Error Resume Next
wrk.close
cdb.close
Db1.close
set dbe = nothing
MsgBox "End"

ポイント

Inの使い方

外部ファイルから流し込むときは後ろになる

"Select [外部テーブル].* into [作成する内部テーブルめい] FROM [外部テーブル] In """ & stgMDB & """;"

外部ファイルへエクスポートするときは、

"Select [内部テーブル名].* Into [作成する外部テーブル名] IN """ & stgMDB & """From [内部テーブル名];"

Inはエクスポートしたい内部テーブルの後ろか、流し込む外部テーブルの後ろにつく

外部ファイル名の前後はダブルクォーテーションが３つ必要になる

空集合のクエリでテーブルの主要な構造を複写

cdb.Execute ("Select * INTO [T_MasCopy] From (SELECT * FROM [T_Master] WHERE (((T_Master.[F1Staff]) Like ""ANONYMOUS"")));")
上の例ではAnonymous さんはいないので必ず空になる
このため空のテーブルが複写される。ただしSQLの範囲なので、細かい書式設定がコピーされるとは限りません。

かっこに注意

Select * Into 後ろでSelectしているため。

Select Intoの間が(*)か[Tablename].*かは後ろで絞り込みがあるかどうかで決まるようです。

さらにこれを応用してテーブルを分割

選択した列だけ複写して、テーブルを列で分割することができる。
その場合でもSQLが使えるため、一方はそのまま、一方は絞り込むか、空のテーブルが出来上がる。
上記のVBSをD:\selectintosambple.vbsとでもして動かしてみてください。
"D:\DbS.MDB"を起動させると複数のテーブルができていることが確認できます。