Windows 10 Pro_x64 + Excel2013_x86 VBA DataBase Access クラスを使って書き込んでみる
Windows 10 Pro_x64 + Excel2013_x86 VBA DataBase Access クラスを使って書き込んでみる
作成した DataBase Access クラスを使用して SQL Server に書き込んでみる
Windows 10 Pro_x64 + Excel2013_x86 VBA DataBase Access クラス
サバ/クラの場合はファイアウォールの設定を確認する
Windows 10 Pro_x64 + SQL Server2017 Expressでファイアウォールを設定する
対象データは以下の全国一括(KEN_ALL.CSV)より一部抜粋
郵便番号データダウンロード
データの並びは以下に準拠
郵便番号データの説明
対象データにユニークキーになりそうなデータが無いので
8桁のテキストを追加する
※Accessからリンクを張るときにも ユニークキーは必須なので
サンプルコード
CREATE TABLE [dbo].[ZIPCODE](
[SEQ] [nchar](8) NOT NULL,
[PREFCODE] [nchar](3) NULL,
[KUBUNCODE] [nchar](8) NULL,
[POSTAL5] [nchar](5) NULL,
[POSTAL] [nchar](8) NULL,
[PREFKANA] [nchar](20) NULL,
[CITIESKANA] [nchar](40) NULL,
[POADDRKANA] [nchar](80) NULL,
[PREFKANJI] [nchar](20) NULL,
[CITIESKANJI] [nchar](40) NULL,
[POADDRKANJI] [nchar](80) NULL,
[FLG1] [int] NULL,
[FLG2] [int] NULL,
[FLG3] [int] NULL,
[FLG4] [int] NULL,
[FLG5] [int] NULL,
[FLG6] [int] NULL
) ON [PRIMARY]
Option ExplicitPrivate Sub CommandButton1_Click()
On Error GoTo ERRPROC
'
Dim DB As DBCtrl
Dim vAry As Variant
Dim blnRet As Boolean
Dim fd As Integer
Dim trLevel As Integer
Dim lngCnt As Long
Dim strSQL As String
Dim strLine As String
Dim fName As String
'
fName = "C:\Dev\code\excelvb\KEN_ALL.CSV"
fd = FreeFile
Open fName For Input As #fd
'
Set DB = New DBCtrl
'
DB.DBName = "SQLSVODBC32"
DB.UserName = "demo"
DB.Password = "demo"
'
DB.Connect
'
trLevel = DB.BeginTrans
strSQL = "TRUNCATE TABLE ZIPCODE"
blnRet = DB.ExecuteSQL(strSQL)
'
While Not EOF(fd)
lngCnt = lngCnt + 1
Line Input #fd, strLine
'
strLine = Replace(strLine, """", "")
vAry = Split(strLine, ",")
strSQL = "INSERT INTO ZIPCODE ("
strSQL = strSQL & " SEQ"
strSQL = strSQL & ", PREFCODE"
strSQL = strSQL & ", KUBUNCODE"
strSQL = strSQL & ", POSTAL5"
strSQL = strSQL & ", POSTAL "
strSQL = strSQL & ", PREFKANA "
strSQL = strSQL & ", CITIESKANA "
strSQL = strSQL & ", POADDRKANA "
strSQL = strSQL & ", PREFKANJI "
strSQL = strSQL & ", CITIESKANJI"
strSQL = strSQL & ", POADDRKANJI"
strSQL = strSQL & ", FLG1 "
strSQL = strSQL & ", FLG2"
strSQL = strSQL & ", FLG3"
strSQL = strSQL & ", FLG4"
strSQL = strSQL & ", FLG5"
strSQL = strSQL & ", FLG6"
strSQL = strSQL & ") VALUES ("
strSQL = strSQL & " '" & Right("00000000" & CStr(lngCnt), 8) & "'"
strSQL = strSQL & ", '" & Trim(Left(vAry(0), 2)) & "'"
strSQL = strSQL & ", '" & Trim(vAry(0)) & "'"
strSQL = strSQL & ", '" & Trim(vAry(1)) & "'"
strSQL = strSQL & ", '" & Trim(vAry(2)) & "'"
strSQL = strSQL & ", '" & Trim(vAry(3)) & "'"
strSQL = strSQL & ", '" & Trim(vAry(4)) & "'"
strSQL = strSQL & ", '" & Trim(vAry(5)) & "'"
strSQL = strSQL & ", '" & Trim(vAry(6)) & "'"
strSQL = strSQL & ", '" & Trim(vAry(7)) & "'"
strSQL = strSQL & ", '" & Trim(vAry(8)) & "'"
strSQL = strSQL & ", " & Trim(vAry(9))
strSQL = strSQL & ", " & Trim(vAry(10))
strSQL = strSQL & ", " & Trim(vAry(11))
strSQL = strSQL & ", " & Trim(vAry(12))
strSQL = strSQL & ", " & Trim(vAry(13))
strSQL = strSQL & ", " & Trim(vAry(14))
strSQL = strSQL & ")"
'
Call DB.ExecuteSQL(strSQL)
Wend
'
trLevel = DB.CommitTrans
blnRet = DB.DisConnect
'
Close #fd
Exit Sub
'
ERRPROC:
trLevel = DB.RollbackTrans
blnRet = DB.DisConnect
'
Close #fd
'
End Sub