データベース
Create文作成
Create文作成
Sub データベース_Create文作成() 'SQL（Innsert文）を作成する。 '移行データベース Const const_テーブル名_移行 As String = "C3" Const const_フィールド名_移行 As Integer = 2 Const const_型_移行 As Integer = 3 Const const_サイズ_移行 As Integer = 4 Const const_小数点_移行 As Integer = 5 Const const_NULL_移行 As Integer = 7 Const const_主キー_移行 As Integer = 7 Const const_データ型_移行 As Integer = 9 Const const_開始行_移行 As Integer = 7 '連携データベース Const const_テーブル名_連携 As String = "E5" Const const_フィールド名_連携 As Integer = 11 Const const_型_連携 As Integer = 19 Const const_サイズ_連携 As Integer = 23 Const const_小数点_連携 As Integer = 25 Const const_NULL_連携 As Integer = 27 Const const_主キー_連携 As Integer = 29 Const const_データ型_連携 As Integer = 19 Const const_開始行_連携 As Integer = 9 'データベース Dim r_フィールド名 As Integer Dim r_型 As Integer Dim r_サイズ As Integer Dim r_小数桁 As Integer Dim r_NULL As Integer Dim r_主キー As Integer Dim r_データ型 As Integer Dim r_開始行 As Integer Dim w_テーブル名 As String Dim w_データ型名 As String Dim w_小数桁 As String Dim w_str As String Dim w_str_field As String Dim w_str_null As String Dim w_str_type As String Dim w_str_key As String Dim s As Worksheet Dim r_start As Long Dim r_end As Long Dim c_start As Long Dim c_end As Long Dim i As Long Dim j As Long Set s = ActiveSheet With s.UsedRange r_start = .Row r_end = .Row + .Rows.Count - 1 c_start = .Column c_end = .Column + .Columns.Count - 1 End With If s.Range("B5").Value = "フィールド名" Then w_テーブル名 = const_テーブル名_移行 r_フィールド名 = const_フィールド名_移行 r_型 = const_型_移行 r_型 = const_型_移行 r_サイズ = const_サイズ_移行 r_小数桁 = const_小数点_移行 r_NULL = const_NULL_移行 r_主キー = const_主キー_移行 r_データ型 = const_データ型_移行 r_開始行 = const_開始行_移行 Else w_テーブル名 = const_テーブル名_連携 r_フィールド名 = const_フィールド名_連携 r_型 = const_型_連携 r_サイズ = const_サイズ_連携 r_小数桁 = const_小数点_連携 r_NULL = const_NULL_連携 r_主キー = const_主キー_連携 r_データ型 = const_データ型_連携 r_開始行 = const_開始行_連携 End If w_str_field = "CREATE TABLE [dbo].[" & s.Range(w_テーブル名).Value & "](" For i = r_開始行 To r_end
Application.StatusBar = i
If s.Cells(i, r_フィールド名).Value <> "" Then If Trim(s.Cells(i, r_NULL).Value) <> "" Then w_str_null = " NOT NULL," Else w_str_null = " NULL," End If If s.Cells(i, r_データ型).Value <> "" Then w_データ型名 = s.Cells(i, r_データ型).Value Else If s.Cells(i, r_型).Value = "数値" Then w_データ型名 = "DECIMAL" ElseIf s.Cells(i, r_型).Value = "ﾃｷｽﾄ" Then w_データ型名 = "NVARCHAR" ElseIf s.Cells(i, r_型).Value = "Yes/No" Then w_データ型名 = "bit" ElseIf s.Cells(i, r_型).Value = "日付/時刻" Then w_データ型名 = "datetime" Else w_データ型名 = s.Cells(i, r_型).Value End If End If If s.Cells(i, r_小数桁).Value = "" Then w_小数桁 = 0 Else w_小数桁 = s.Cells(i, r_小数桁).Value End If If w_データ型名 = "DECIMAL" Then w_str_type = "(" & s.Cells(i, r_サイズ).Value & "," & w_小数桁 & ")" ElseIf w_データ型名 = "numeric" Then w_str_type = "(" & s.Cells(i, r_サイズ).Value & "," & w_小数桁 & ")" ElseIf w_データ型名 = "DATETIME" Then w_str_type = "" ElseIf w_データ型名 = "BIT" Then w_str_type = "" Else w_str_type = "(" & s.Cells(i, r_サイズ).Value & ")" End If w_str_field = w_str_field & Chr(13) & " " _ & "[" & s.Cells(i, r_フィールド名).Value & "]" _ & "[" & w_データ型名 & "]" _ & w_str_type & w_str_null End If Next i w_str_key = " CONSTRAINT [PK_" & s.Range(w_テーブル名).Value & "] PRIMARY KEY CLUSTERED " & Chr(13) & "(" For i = r_開始行 To r_end Application.StatusBar = i If Trim(s.Cells(i, r_主キー).Value) <> "" Then w_str_key = w_str_key & Chr(13) & " " & "[" & s.Cells(i, r_フィールド名).Value & "] ASC," End If Next i w_str_key = Left(w_str_key, Len(w_str_key) - 1) w_str_key = w_str_key & Chr(13) & ")WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON, OPTIMIZE_FOR_SEQUENTIAL_KEY = OFF) ON [PRIMARY]" w_str_key = w_str_key & Chr(13) & ") ON [PRIMARY]" On Error Resume Next Err.Clear ActiveSheet.Shapes.SelectAll If Err.Number = 0 Then If Selection.ShapeRange.Count > 0 Then Selection.ShapeRange.Delete End If End If On Error GoTo 0 w_str = "USE [KZSDB_xxxxx]" & Chr(13) w_str = w_str & "GO" & Chr(13) & Chr(13) w_str = w_str & "/****** Object: Table [dbo].[" & s.Range(w_テーブル名).Value & "] Script Date: " & Now & " ******/" & Chr(13) w_str = w_str & "SET ANSI_NULLS ON" & Chr(13) w_str = w_str & "GO" & Chr(13) & Chr(13) w_str = w_str & "SET QUOTED_IDENTIFIER ON" & Chr(13) w_str = w_str & "GO" & Chr(13) & Chr(13) w_str = w_str & w_str_field & Chr(13) & w_str_key & Chr(13) w_str = w_str & "GO" ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 800, 100, 1000, 500).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = w_str ' MsgBox "終了" Application.StatusBar = False End Sub
Application.StatusBar = i
If s.Cells(i, r_フィールド名).Value <> "" Then If Trim(s.Cells(i, r_NULL).Value) <> "" Then w_str_null = " NOT NULL," Else w_str_null = " NULL," End If If s.Cells(i, r_データ型).Value <> "" Then w_データ型名 = s.Cells(i, r_データ型).Value Else If s.Cells(i, r_型).Value = "数値" Then w_データ型名 = "DECIMAL" ElseIf s.Cells(i, r_型).Value = "ﾃｷｽﾄ" Then w_データ型名 = "NVARCHAR" ElseIf s.Cells(i, r_型).Value = "Yes/No" Then w_データ型名 = "bit" ElseIf s.Cells(i, r_型).Value = "日付/時刻" Then w_データ型名 = "datetime" Else w_データ型名 = s.Cells(i, r_型).Value End If End If If s.Cells(i, r_小数桁).Value = "" Then w_小数桁 = 0 Else w_小数桁 = s.Cells(i, r_小数桁).Value End If If w_データ型名 = "DECIMAL" Then w_str_type = "(" & s.Cells(i, r_サイズ).Value & "," & w_小数桁 & ")" ElseIf w_データ型名 = "numeric" Then w_str_type = "(" & s.Cells(i, r_サイズ).Value & "," & w_小数桁 & ")" ElseIf w_データ型名 = "DATETIME" Then w_str_type = "" ElseIf w_データ型名 = "BIT" Then w_str_type = "" Else w_str_type = "(" & s.Cells(i, r_サイズ).Value & ")" End If w_str_field = w_str_field & Chr(13) & " " _ & "[" & s.Cells(i, r_フィールド名).Value & "]" _ & "[" & w_データ型名 & "]" _ & w_str_type & w_str_null End If Next i w_str_key = " CONSTRAINT [PK_" & s.Range(w_テーブル名).Value & "] PRIMARY KEY CLUSTERED " & Chr(13) & "(" For i = r_開始行 To r_end Application.StatusBar = i If Trim(s.Cells(i, r_主キー).Value) <> "" Then w_str_key = w_str_key & Chr(13) & " " & "[" & s.Cells(i, r_フィールド名).Value & "] ASC," End If Next i w_str_key = Left(w_str_key, Len(w_str_key) - 1) w_str_key = w_str_key & Chr(13) & ")WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON, OPTIMIZE_FOR_SEQUENTIAL_KEY = OFF) ON [PRIMARY]" w_str_key = w_str_key & Chr(13) & ") ON [PRIMARY]" On Error Resume Next Err.Clear ActiveSheet.Shapes.SelectAll If Err.Number = 0 Then If Selection.ShapeRange.Count > 0 Then Selection.ShapeRange.Delete End If End If On Error GoTo 0 w_str = "USE [KZSDB_xxxxx]" & Chr(13) w_str = w_str & "GO" & Chr(13) & Chr(13) w_str = w_str & "/****** Object: Table [dbo].[" & s.Range(w_テーブル名).Value & "] Script Date: " & Now & " ******/" & Chr(13) w_str = w_str & "SET ANSI_NULLS ON" & Chr(13) w_str = w_str & "GO" & Chr(13) & Chr(13) w_str = w_str & "SET QUOTED_IDENTIFIER ON" & Chr(13) w_str = w_str & "GO" & Chr(13) & Chr(13) w_str = w_str & w_str_field & Chr(13) & w_str_key & Chr(13) w_str = w_str & "GO" ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 800, 100, 1000, 500).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = w_str ' MsgBox "終了" Application.StatusBar = False End Sub
接続実行切断
接続実行切断
'「Microsoft ActiveX Data Objects X.X Library」を有効にする。
'Windows認証で接続する場合Public Const PROVIDER As String = "SQLOLEDB"Public DATA_SOURCE As String 'サーバ名Public DATABASE As String 'データベース名
'SQL Server認証で接続する場合Public Const USER_ID As String = "UID=user" 'ユーザIDPublic Const PASSWORD As String = "password" 'ユーザパスワード
Public cn As New ADODB.ConnectionPublic rs As New ADODB.Recordset
Public strSQL As String
Sub データベース_接続実行切断()
'■ サーバー情報設定 DATA_SOURCE = "PC1665\SQLEXPRESS" DATABASE = "KZSDB_xxxxx" '-------------------------------- ' データベース接続 '-------------------------------- 'Windows認証で接続する場合 cn.ConnectionString = "Provider=" & PROVIDER _ & ";Data Source=" & DATA_SOURCE _ & ";Initial Catalog=" & DATABASE _ & ";Trusted_Connection=Yes" cn.Open
' 'SQL Server認証で接続する場合' cn.ConnectionString = "Provider=" & PROVIDER _' & ";Data Source=" & DATA_SOURCE _' & ";Initial Catalog=" & DATABASE _' & ";UID=" & USER_ID _' & ";PWD=" & PASSWORD' cn.Open
strSQL = "SELECT MAX([SIKIBETSUNO]) FROM TBL_JJYUKI" Debug.Print strSQL '-------------------------------- ' SQLの実行 '-------------------------------- If Not rs Is Nothing Then Set rs = Nothing End If rs.Open strSQL, cn
If rs.RecordCount > 0 Then Debug.Print "⇒SIKIBETSUNO=" & rs![SIKIBETSUNO] Else Debug.Print "⇒s.RecordCount=" & rs.RecordCount End If
'-------------------------------- ' データベース切断 '-------------------------------- If Not rs Is Nothing Then If rs.State = adStateOpen Then rs.Close Set rs = Nothing End If If Not cn Is Nothing Then If cn.State = adStateOpen Then cn.Close Set cn = Nothing End If
End Sub
'Windows認証で接続する場合Public Const PROVIDER As String = "SQLOLEDB"Public DATA_SOURCE As String 'サーバ名Public DATABASE As String 'データベース名
'SQL Server認証で接続する場合Public Const USER_ID As String = "UID=user" 'ユーザIDPublic Const PASSWORD As String = "password" 'ユーザパスワード
Public cn As New ADODB.ConnectionPublic rs As New ADODB.Recordset
Public strSQL As String
Sub データベース_接続実行切断()
'■ サーバー情報設定 DATA_SOURCE = "PC1665\SQLEXPRESS" DATABASE = "KZSDB_xxxxx" '-------------------------------- ' データベース接続 '-------------------------------- 'Windows認証で接続する場合 cn.ConnectionString = "Provider=" & PROVIDER _ & ";Data Source=" & DATA_SOURCE _ & ";Initial Catalog=" & DATABASE _ & ";Trusted_Connection=Yes" cn.Open
' 'SQL Server認証で接続する場合' cn.ConnectionString = "Provider=" & PROVIDER _' & ";Data Source=" & DATA_SOURCE _' & ";Initial Catalog=" & DATABASE _' & ";UID=" & USER_ID _' & ";PWD=" & PASSWORD' cn.Open
strSQL = "SELECT MAX([SIKIBETSUNO]) FROM TBL_JJYUKI" Debug.Print strSQL '-------------------------------- ' SQLの実行 '-------------------------------- If Not rs Is Nothing Then Set rs = Nothing End If rs.Open strSQL, cn
If rs.RecordCount > 0 Then Debug.Print "⇒SIKIBETSUNO=" & rs![SIKIBETSUNO] Else Debug.Print "⇒s.RecordCount=" & rs.RecordCount End If
'-------------------------------- ' データベース切断 '-------------------------------- If Not rs Is Nothing Then If rs.State = adStateOpen Then rs.Close Set rs = Nothing End If If Not cn Is Nothing Then If cn.State = adStateOpen Then cn.Close Set cn = Nothing End If
End Sub