[VBA] 엑셀 -> MS-SQL

엑셀 -> MS-SQL　データ取込み

' 注意
' ツール > 参照設定 > Microsoft ActiveX Data Objects x.x Library 設置が必要

Private Const DB_Connection As String = "Provider=SQLOLEDB.1;Password=암호;Persist Security Info=True;User ID=아이디;Initial Catalog=DB명;Data Source=서버이름"
Private Const INSERT_COLUMN As String = "(ID, JobID, TableName, FieldName, LabelName, TabIndex, ViewIndex, SortOrder, ConditionFlag, ColmunIndex, LabelForeColorR, LabelForeColorG, LabelForeColorB, LabelBackColorR, LabelBackColorG, LabelBackColorB, DataForeColorR, DataForeColorG, DataForeColorB, DataBackColorR, DataBackColorG, DataBackColorB, LabelAlignment, DataAlignment, CallFlag, DataIdentification, ExportIndex, PhoneBookExportIndex, FormatSentence, LabelAliasData, UpdateEnbale, SubCodeField, IMEMode)"

Private Sub CommandButton1_Click()
   
    If MsgBox("データベースに反映してもよろしいですか？", vbYesNo + vbQuestion, "処理実行確認") = vbYes Then MS_SQL_DataBase
   
End Sub

Sub MS_SQL_DataBase()

    Dim SQL         As String
    Dim oCmd        As ADODB.Command
    Dim i           As Long
    Dim j           As Long
    Dim Total       As Long
    Dim cntRow      As Long
    Dim cntColumn   As Long
   
    ' 項目名
    Dim sData       As String
    Dim sDataBuff   As String
   
    Dim DELETE_SQL  As String
    Dim CHECKIDENT  As String
    Dim INSERT_SQL  As String
   
    On Error GoTo err
   
    'データ数カウンター
    cntRow = CLng(Range("A1").End(xlDown).Row) - 2
    cntColumn = CLng(Range("IV1").End(xlToLeft).Column) - 1

    ' DB接続
    Set oCmd = New ADODB.Command
    oCmd.ActiveConnection = DB_Connection
    oCmd.CommandType = adCmdText
   
    ' 既存のデータ削除
    DELETE_SQL = "DELETE FROM [dbo].[CCAP_DataMapping]"
    oCmd.CommandText = DELETE_SQL
    oCmd.Execute
   
    ' ID値を初期化
    CHECKIDENT = "DBCC CHECKIDENT ([CCAP_PrefectureMaster], RESEED, 0)"
    oCmd.CommandText = CHECKIDENT
    oCmd.Execute

    For i = 0 To cntRow

        'データ設定
        sData = ""
        sData = Range("A2").Offset(i, 0)

        'データがない場合チェック(2番目の項目名を基準とする)
        If Not Range("A2").Offset(i, 1) = "" Then
            For j = 1 To cntColumn
                '文字列処理
                If j = 2 Or j = 3 Or j = 4 Or j = 28 Or j = 29 Or j = 31 Then
                    sDataBuff = "'" & Range("A2").Offset(i, j) & "'"
                Else
                    sDataBuff = Range("A2").Offset(i, j)
                    '必修処理
                    If sDataBuff = "" Then sDataBuff = 0
                End If
               
                sData = sData & ", " & sDataBuff
               
            Next j
   
            ' 取込
            INSERT_SQL = "INSERT INTO [dbo].[CCAP_DataMapping]" & INSERT_COLUMN & " VALUES (" & sData & ")"
            oCmd.CommandText = INSERT_SQL
            oCmd.Execute
        End If
    Next i

    Set oCmd = Nothing
   
Exit Sub

err:
    MsgBox "エラーが発生しました。サーバーの設定やデータの完全性を確認してください。"

End Sub