Sub auto_open()
Application.CommandBars("cell").Reset
With Application.CommandBars("cell").Controls.Add
.OnAction = "t"
.Caption = "テーブル作成・登録"
End With
With Application.CommandBars("cell").Controls.Add
.OnAction = "e"
.Caption = "SQL実行"
End With
End Sub
Sub auto_close()
On Error Resume Next
For i = 1 To 2
Application.CommandBars("cell").Controls("テーブル作成・登録").Delete
Application.CommandBars("cell").Controls("SQL実行").Delete
Next i
End Sub
Sub t()
Set cn = CreateObject("adodb.connection")
cn.Open "Provider=SQLOLEDB;Data Source=PC\SQLEXPRESS;Initial Catalog=my_database;Integrated Security=SSPI;"
tbl = InputBox("テーブル名")
If tbl = "" Then Exit Sub
'テーブル削除
On Error Resume Next
cn.Execute "drop table " & tbl
'テーブル作成
On Error GoTo 0
fld = ""
For c = Selection(1).Column To Selection(Selection.Count).Column
Select Case Right(ActiveSheet.Cells(Selection(1).Row, c).Value, 1)
Case "s"
tmp = "varchar(255)"
Case "i"
tmp = "bigint"
Case "m"
tmp = "money"
Case "d"
tmp = "datetime"
End Select
fld = fld & ActiveSheet.Cells(Selection(1).Row, c).Value & " " & tmp & ","
Next c
fld = Left(fld, Len(fld) - 1)
q = "create table " & tbl & " (id integer identity(1,1) primary key," & fld & ")": Debug.Print q
cn.Execute q
'データ登録
fld = ""
For c = Selection(1).Column To Selection(Selection.Count).Column
fld = fld & ActiveSheet.Cells(Selection(1).Row, c).Value & ","
Next c
fld = Left(fld, Len(fld) - 1)
For r = (Selection(1).Row) + 1 To Selection(Selection.Count).Row
For cc = Selection(1).Column To Selection(Selection.Count).Column
rec = rec & "'" & ActiveSheet.Cells(r, cc).Value & "'" & ","
Next cc
rec = Left(rec, Len(rec) - 1)
q = "insert into " & tbl & " (" & fld & ") values (" & rec & ")": Debug.Print q
cn.Execute q
rec = ""
Next r
If cn.State = 1 Then cn.Close
Set cn = Nothing
MsgBox "done"
End Sub
Sub s(q)
Set cn = CreateObject("adodb.connection")
Set rn = CreateObject("adodb.recordset")
cn.Open "Provider=SQLOLEDB;Data Source=PC\SQLEXPRESS;Initial Catalog=my_database;Integrated Security=SSPI;"
rn.Open q, cn
'フィールド作成
i = 0
For c = Selection(1).Column To (Selection(1).Column + rn.Fields.Count) - 1
Cells(Selection(Selection.Count).Row + 1, c).Value = rn.Fields(i).Name
i = i + 1
Next c
'データ読込
Cells(Selection(Selection.Count).Row + 2, Selection(1).Column).CopyFromRecordset rn
If rn.State = 1 Then rn.Close
Set rn = Nothing
If cn.State = 1 Then cn.Close
Set cn = Nothing
End Sub
Sub o(q)
Set cn = CreateObject("adodb.connection")
cn.Open "Provider=SQLOLEDB;Data Source=PC\SQLEXPRESS;Initial Catalog=my_database;Integrated Security=SSPI;"
cn.Execute q
If cn.State = 1 Then cn.Close
Set cn = Nothing
End Sub
Sub e()
If Selection.Rows.Count = 1 Then
q = ActiveCell.Value
Else
For r = 1 To Selection.Rows.Count
q = q & " " & Selection(r)
Next r
End If
If Left(q, 1) = "s" Then
s (q)
Else
o (q)
End If
End Sub