読者です 読者をやめる 読者になる 読者になる

事務屋さんの備忘録

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

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

VBA

シート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