TOP絵変更 → 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41  クリックすると変更されます
HOME

スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

【SQL魔法】エクセル表⇒INERT文変換&実行【アルティマ・シュート】

前の記事のティロ・フィナーレの改良版。

改良点
・色々なエラーチェックが追加
・SQLServerに直接INSERT、及びDELETEする処理を追加

まぁ、改良点は上の2点だけなんだが、かなりコードが増えてる。
SQLServerに接続して色々するやつはエクセルのシート上で
ON,OFFできるようになっている。

画面でも乗せとくか。
アルティマシュート画面


また、SQLServerに接続する際の情報はそれぞれの環境で変わるため注意。
ついでに参照設定も必要なので乗せておく。
みんなおなじみのADOだ。
アルティマシュート参照設定


てことで以下にソース






Const STR_INSERT_START = "insert into "
Const STR_INSERT_VALUES = " values ("
Const STR_NULL = "null"
Const STR_SQ = "'"
Const STR_COMMA = ", "
Const STR_INSERT_END = ");"
Const STR_CLEAR = ""
Const OUTPUT_X = 4
Const OUTPUT_RANGE_X = "D:D"
Const ZERO_CLEAR = 0
Const INPUT_X = 2
Const SHEET_NAME_Y = 1
Const TABLE_NAME_Y = 2
Const EXECUTE_Y = 10
Const DELETE_Y = 11
Const EXECUTE_ON = "ON"
Const DELETE_ON = "ON"
Const MSG_DELETE_ON = "自動削除がONになっています。よろしいですか?"
Const MSG_EXIT = vbCr & "処理を終了します。"
Const MSG_CANCEL = "処理をキャンセルしました。"
Const ERR_MSG_INSERT = "SQLServerへのINSERT処理が異常終了しました。" & MSG_EXIT
Const ERR_MSG_DELETE = "SQLServerへのDELETE処理が異常終了しました。" & MSG_EXIT
Const ERR_MSG_RECORD = "エクセル表にレコードがありませんでした。" & MSG_EXIT
Const ERR_MSG_SHEET = "指定したシートが見つかりませんでした。" & MSG_EXIT


'--------------------------------------------------------------------------------------------
' INSERT文生成ボタン押下
'--------------------------------------------------------------------------------------------
Private Sub cmbInsertCreate_Click()

Dim chk As Boolean

' 自動削除が"ON"の場合、確認ダイアログ表示
If Cells(DELETE_Y, INPUT_X).Value = DELETE_ON Then
msgIf = MsgBox(MSG_DELETE_ON, vbYesNo)

If msgIf = vbNo Then
MsgBox MSG_CANCEL
Exit Sub
End If
End If

' 描画OFF
Application.ScreenUpdating = False

' ■エクセル表⇒INSERT文生成処理■
chk = InsertCreate

' 描画ON
Application.ScreenUpdating = True

' 終了メッセージ 異常終了の場合は終了メッセージを表示しない
If chk = True Then
If Cells(EXECUTE_Y, INPUT_X).Value = EXECUTE_ON Then
MsgBox "INSERT文 生成&実行完了"
Else
MsgBox "INSERT文 生成完了"
End If
End If

End Sub


'--------------------------------------------------------------------------------------------
' 出力エリアクリアボタン押下
'--------------------------------------------------------------------------------------------
Private Sub cmbOutputClear_Click()

' ■出力エリアクリア処理■
Output_Clear

End Sub


'--------------------------------------------------------------------------------------------
' SQLServerAllDeleteボタン押下
'--------------------------------------------------------------------------------------------
Private Sub cmdDeleteTable_Click()

Dim chk As Boolean

' ■SQLServer側のテーブル全削除処理■
chk = Delete_Table(False, ActiveSheet.Name)

End Sub


'============================================================================================
' エクセル表⇒INSERT文生成処理
'============================================================================================
Function InsertCreate() As Boolean

InsertCreate = False

On Error Resume Next

' 変数宣言
Dim SheetName As String
Dim OutSheetName As String
Dim TableName As String
Dim strSQL As String
Dim matrix_X As Integer
Dim matrix_Y As Integer
Dim i As Integer
Dim j As Integer
Dim adoCON As New ADODB.Connection
Dim chk As Boolean

' 各項目クリア
SheetName = STR_CLEAR
OutSheetName = STR_CLEAR
TableName = STR_CLEAR
strSQL = STR_CLEAR
matrix_X = ZERO_CLEAR
matrix_Y = ZERO_CLEAR
i = ZERO_CLEAR
j = ZERO_CLEAR
chk = True

' 入力データ読み込み
SheetName = Cells(SHEET_NAME_Y, INPUT_X).Value
OutSheetName = ActiveSheet.Name
TableName = Cells(TABLE_NAME_Y, INPUT_X).Value

' ■シート存在チェック■
chk = Sheet_Chk(SheetName)
If chk = False Then
Exit Function
End If

' ■出力エリアクリア■
Output_Clear

' エクセル表の項目数取得(X座標)
Sheets(SheetName).Select
Sheets(SheetName).Cells(1, 1).Select
Selection.End(xlToRight).Select
matrix_X = ActiveCell.Column

' エクセル表のレコード件数取得(Y座標)
For i = 1 To matrix_X
Sheets(SheetName).Cells(65536, i).Select
Selection.End(xlUp).Select
If matrix_Y < ActiveCell.Row And 65536 <> ActiveCell.Row Then
matrix_Y = ActiveCell.Row
End If
Next i

' エクセル表にレコードがなかった場合、エラー終了
If matrix_Y < 2 Then
Sheets(OutSheetName).Select
MsgBox ERR_MSG_RECORD
Exit Function
End If

' 自動削除が"ON"の場合、DELETE実行
If Sheets(OutSheetName).Cells(DELETE_Y, INPUT_X).Value = DELETE_ON Then
' ■SQLServer側のテーブル全削除処理■
chk = Delete_Table(True, OutSheetName)
If chk = False Then
Exit Function
End If
End If

' INSERT文生成
' レコード件数分、処理を繰り返す(項目名はレコード件数に含めないため、2からスタート)
For i = 2 To matrix_Y

' INSERT文の冒頭部分を設定
strSQL = STR_INSERT_START & TableName & STR_INSERT_VALUES

' 各データをINSERT文用に整形
' 項目件数分、処理を繰り返す
For j = 1 To matrix_X

' 空白だった場合"NULL"を設定 それ以外の場合はデータを設定
If Sheets(SheetName).Cells(i, j).Value = STR_CLEAR Then
strSQL = strSQL & STR_NULL
Else
' データがあった場合はシングルクォーテーションで囲む
strSQL = strSQL & STR_SQ & Sheets(SheetName).Cells(i, j).Value & STR_SQ
End If

' 最後の項目まで処理をしたか判定
' 最後の項目だった場合、INSERT文の末尾を設定 それ以外の場合はカンマを設定
If j = matrix_X Then
strSQL = strSQL & STR_INSERT_END
Else
strSQL = strSQL & STR_COMMA
End If

Next j

' 生成したINSERT文を出力
Sheets(OutSheetName).Cells(i, OUTPUT_X).Value = strSQL

' 直実行が"ON"の場合、SQLServerに書き込み
If Sheets(OutSheetName).Cells(EXECUTE_Y, INPUT_X).Value = EXECUTE_ON Then
' データソースオープン
adoCON.Open "dsn=TEST; uid=sa; pwd=test;"

' SQL実行
adoCON.Execute (strSQL)
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical
MsgBox ERR_MSG_INSERT
adoCON.Close
Set adoCON = Nothing
Sheets(OutSheetName).Select
Exit Function
End If

' クローズ
adoCON.Close
End If

Next i

Set adoCON = Nothing

' 出力データが格納されたシートを表示
Sheets(OutSheetName).Select
Cells(matrix_Y + 1, OUTPUT_X).Value = "=A3"

InsertCreate = True

End Function


'============================================================================================
' 出力エリアクリア処理
'============================================================================================
Sub Output_Clear()

Dim OutSheetName As String

OutSheetName = ActiveSheet.Name
Sheets(OutSheetName).Range(OUTPUT_RANGE_X).Value = STR_CLEAR

End Sub


'============================================================================================
' SQLServer側のテーブル全削除処理
'============================================================================================
Function Delete_Table(skipFlg As Boolean, OutSheetName As String) As Boolean

Delete_Table = False

On Error Resume Next

Dim adoCON As New ADODB.Connection
Dim TableName As String
Dim strSQL As String
Dim msgIf As String

TableName = Cells(TABLE_NAME_Y, INPUT_X).Value

' INSERT文生成から呼び出された場合、確認ダイアログはスキップする
If skipFlg = False Then
msgIf = MsgBox("テーブル『" & TableName & "』のデータを全て削除しますか?", vbYesNo)

If msgIf = vbNo Then
MsgBox MSG_CANCEL
Exit Function
End If

End If

' SQL文生成
strSQL = "delete from " & TableName

' データソースオープン
adoCON.Open "dsn=TEST; uid=sa; pwd=test;"

' SQL実行
adoCON.Execute (strSQL)
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical
MsgBox ERR_MSG_DELETE
adoCON.Close
Set adoCON = Nothing
Sheets(OutSheetName).Select
Exit Function
End If

' クローズ
adoCON.Close

Set adoCON = Nothing

' INSERT文生成から呼び出された場合、完了メッセージはスキップする
If skipFlg = False Then
MsgBox "テーブル『" & TableName & "』のデータを全て削除しました。"
End If

Delete_Table = True

End Function


'============================================================================================
' シート存在チェック処理
'============================================================================================
Function Sheet_Chk(SheetName As String) As Boolean

Sheet_Chk = False

Dim ws As Worksheet
Dim flag As Boolean

For Each ws In Worksheets
If ws.Name = SheetName Then
flag = True
End If
Next ws

If flag = False Then
MsgBox ERR_MSG_SHEET
Exit Function
End If

Sheet_Chk = True

End Function
スポンサーサイト

テーマ : テイルズウィーバー
ジャンル : オンラインゲーム

コメントの投稿

非公開コメント

著作権

Copyrights (C) NEXON Corporation and NEXON Co., Ltd.
All Rights Reserved.
乱数試行機

乱数試行機

成功率 %
試行回数 回

成功    :0 回
失敗    :0 回
成功率結果 :0 %
試行回数結果:0 回
簡易MRシミュレータ

簡易MRシミュレータ
by †真・ブリニクルディメンションスレイヤー

S:64 
H:136 
F:17 
I:16 
M:14 
X:16 
A:11 
Q:10 
C:9 
アンチ無
MR費用:0
MR券込:0
回した回数:0

※ステがMAXになると
 黄色文字になります
 ステ自体違う場合はコメントくだs
※ラジオボタンを押下すると
 アンチマジックを使った状態に
なります

個人リンク
みんなの呟き

   



サイト説明
BloodyRosary は
テイルズウィーバーなブログです。
レコ…霧鯖で活動してるってばよ。
TwitterID:yoinagiTW

このブログはリンクフリーです。
+50000
しかしなぜか東方カウンター
自己紹介

宵凪(テチ) Lv:290
3次覚醒済


江戸川ドイル(アナイス) Lv290
2次覚醒済


竜崎シオン(イソ) Lv290
2次覚醒済


ラストセラフィ(ベンヤ) Lv290
2次覚醒済


シルフィアス(ナヤ) Lv:290
2次覚醒済


ジールラファル(マキシ) Lv:255
覚醒済


レスヴィリア(ミラ) Lv:255
覚醒済


聖王リヴァイア(シベ) Lv:255
覚醒済


セレス(クロエ) Lv265
覚醒済


月千夜(ジョシュ) Lv255
覚醒済


雪千夜(ランジエ) Lv255
覚醒済


超社長(イサック) Lv255
覚醒済


ナズナ(ボリ) Lv255
覚醒済


シルベイン(ピン) Lv:255
覚醒済


ディシディア(ルシ) Lv255
覚醒済


メルブレイズ(ロアミニ) Lv255
覚醒済


ルヴァリオ(ノクターン) Lv255
覚醒済


臼いネコ(テチ) Lv290


x音葉x(テチ) Lv199

他のキャラ
セリカ様(アナイス) Lv290
黒銀シア(ピン) Lv274
全キャラレコ…霧鯖で適当に活動中
今までの絵
右下に行くほど新
左上に行くほど古
リンクにマウスをあわせると
縮小画像表示

ちなみに読み込み遅いです。
最新コメント
カレンダー
07 | 2017/08 | 09
- - 1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30 31 - -
カテゴリ
リンク
テスト
クリックすると
シナリオ開始 
 
検索フォーム
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。