事務屋さんの備忘録

主にプログラミングのことを書いていきます。メモというか備忘録的な感じで。プログラミングといっても、私はプロのエンジニアでも本職のプログラマーでもありません。単なる事務職をやってるサラリーマンで、空いた時間にちょこちょこっとプログラミングしてる程度です。よってこのブログに記載したことが誤っていたり、もっとよい方法がある場合もあると思います。その場合には、ご指摘いただけると嬉しいです。また、このブログを読んで役に立った、なんて方がいらっしゃったら幸いですね。

Excel VBA で SQL Serverに一時テーブルを作成し、データ投入及びデータ存在確認を行う

シート1のデータを一時テーブルに格納し、格納されたことを確認する為に、シート2へ書き出します。

Option Explicit

Dim myWshNetwork As New IWshRuntimeLibrary.WshNetwork  'Windows Script Host Object Model を参照設定

Dim myCon As ADODB.Connection
Dim myCmd As ADODB.Command
Dim myRst As ADODB.Recordset

Dim SQL_TEXT As String
Dim lngCount As Long
Dim lngY     As Long

Dim strUName    As String    'ユーザー名
Dim strComName  As String    'コンピュータ名
Dim strDomName  As String    'ドメイン名

Sub SQL2008EE_Test()
    
'    【特徴】
'     1.一時テーブルは、システムが暗黙的に削除する
'     2.一時テーブルは、システムデータベース(tempdb)内に作成する
'
'    【種類】
'     1.ローカル一時テーブル
'        作成したユーザだけが利用できる一時テーブル
'        ユーザがセッションを切断するときに削除される
'     2.グローバル一時テーブル
'        データベース内の全ユーザが利用できる一時テーブル
'        一時テーブルを参照している全ユーザのセッションが切断されたときに削除される
'
'      以下、一時テーブルの定義方法
'     1.ローカル一時テーブル
'      CREATE TABLE #テーブル名
'       (id CHAR(5) NOT NULL,
'        name CHAR(30))
'
'     2.グローバル一時テーブル
'      CREATE TABLE ##テーブル名
'       (id CHAR(5) NOT NULL,
'        name CHAR(30))
'
'    【補足事項】
'    ・ローカル一時テーブルは、テーブル名の先頭に#を付ける
'    ・グローバル一時テーブルは、テーブル名の先頭に#を2つ付ける

    Set myCon = New ADODB.Connection
    
    myCon.Open "Provider = MSDASQL.1;Data Source=SQL_TEST;Initial Catalog=sampleDB;", _
                UserID:="XXXXXXXX", _
                Password:="XXXXXXX"

    
    Set myCmd = New ADODB.Command
    myCmd.ActiveConnection = myCon
    
    
    On Error GoTo Tran_Err
    
    myCon.BeginTrans    'トランザクション処理スタート======================================
    
        
        Call Get_UserName
        
                   SQL_TEXT = "CREATE TABLE #"
        SQL_TEXT = SQL_TEXT & strUName
        SQL_TEXT = SQL_TEXT & "("
        SQL_TEXT = SQL_TEXT & "社員番号 INTEGER PRIMARY KEY,"
        SQL_TEXT = SQL_TEXT & "氏名 CHAR(50),"
        SQL_TEXT = SQL_TEXT & "給与 INTEGER,"
        SQL_TEXT = SQL_TEXT & "入社日 DATE,"
        SQL_TEXT = SQL_TEXT & "手当 INTEGER)"
        
        myCmd.CommandText = SQL_TEXT
        myCmd.Execute
    
        
        lngCount = Cells(1, 1).End(xlDown).Row

        lngY = 2
        Do Until lngY > lngCount

            '◆文字型と日付型は'(シングルクオーテーション)で囲む
            
            With Sheet1

                SQL_TEXT = "INSERT INTO #"
                SQL_TEXT = SQL_TEXT & strUName
                SQL_TEXT = SQL_TEXT & " VALUES("
                SQL_TEXT = SQL_TEXT & .Cells(lngY, 1) & ","
                SQL_TEXT = SQL_TEXT & "'" & .Cells(lngY, 2) & "',"
                SQL_TEXT = SQL_TEXT & .Cells(lngY, 3) & ","
                SQL_TEXT = SQL_TEXT & "'" & .Cells(lngY, 4) & "',"
                SQL_TEXT = SQL_TEXT & .Cells(lngY, 5) & ")"
            
            End With

            myCmd.CommandText = SQL_TEXT
            myCmd.Execute

            lngY = lngY + 1
        Loop
    
    
    myCon.CommitTrans  'トランザクション処理ここまで 変更をまとめて書き込む=================
    
    
    '該当データの取得(一時テーブルに格納されているかチェック)------------------------------
    Dim i As Integer
    
    Set myRst = New ADODB.Recordset
    
    SQL_TEXT = "SELECT * FROM #" & strUName
    
    'レコードセットを開く
    With myRst
        
        .ActiveConnection = myCon
        .Source = Trim(SQL_TEXT)
        .Open
    
        'フィールド名
        For i = 1 To .Fields.Count
            Sheet2.Cells(1, i) = .Fields(i - 1).Name
        Next

    End With
    
    lngY = 2
    Do Until myRst.EOF = True
        
        With Sheet2
        
            .Cells(lngY, 1) = myRst![社員番号]
            .Cells(lngY, 2) = myRst![氏名]
            .Cells(lngY, 3) = myRst![給与]
            .Cells(lngY, 4) = myRst![入社日]
            .Cells(lngY, 5) = myRst![手当]
            
        End With
        
        myRst.MoveNext
        lngY = lngY + 1
    
    Loop
    
    myRst.Close
    Set myRst = Nothing
    '----------------------------------------------------------------------------------------
    
    
    myCon.Close
    Set myCmd = Nothing
    Set myCon = Nothing
    
    MsgBox "完了!"
    
    End
    

Tran_Err:

    MsgBox "SQL更新時にエラーが発生しました。変更を破棄して終了します...", vbCritical, "Error!"
    
    
    myCon.RollbackTrans  'トランザクション処理の変更を破棄して元の状態に戻す=================
    
    
    myCon.Close
    Set myCmd = Nothing
    Set myCon = Nothing
    
    End
    
End Sub

Sub Get_UserName()

    With myWshNetwork
        strUName = .UserName          'ユーザー名取得
        strComName = .ComputerName    'コンピュータ名取得
        strDomName = .UserDomain      'ドメイン名取得
    End With
    
    Set myWshNetwork = Nothing
    
End Sub