VBA_SQL_insert - note4recurrent @ ウィキ

Option Explicit

Sub update() ' 一括insert ' datシートのデータからSQL文を生成し実行するただし、このプログラムでは実行はしない

Application.ScreenUpdating = False '画面描画の停止

' SQL実行

   Dim str As Variant                                          'SQL文を入れる変数
   str = makeSQL()                                             'SQL生成
   execSQL (str)                                               '実行
   

'ApplicamakeSQLtion.ScreenUpdating = True '画面描画の停止解除

End Sub

Sub execSQL(str As Variant) '＝＝＝＝＝＝＝＝＝＝＝＝＝＝DB接続

   Dim i As Integer
   Dim openFl  As Boolean
   openFl = False                      'オープンフラグ
   Dim db      As ADODB.connection     'アクセス用のオブジェクト宣言
   
   'エラー処理の宣言
   On Error GoTo ErrorHandler
   
   If db Is Nothing Then                   'インスタンスが存在しない場合
       Set db = New ADODB.connection       'インスタンス生成
       openFl = True                       'オープンフラグをTrue
   Else    'オブジェクトが存在する場合
       If db.State = adStateClosed Then    'コネクション状態がクローズの場合
           openFl = True                   'オープンフラグオン
       End If
   End If
   
   If openFl = True Then                   'オープンフラグがオンの場合 DB に接続
       db.Open "Provider=****;" & _
           "Data Source=****;" & _
           "Initial Catalog= ****;" & _
           "User Id=******;" & _
           "Password=*******;"
   '    Call MsgBox("接続されました", vbInformation)
   End If
   
   '＝＝＝＝＝＝＝＝＝＝＝＝＝＝SQL実行
   For i = 1 To UBound(str)

' db.Execute str(i) 'SQL実行:架空のテーブルなのでコメントを外すとエラーで落ちる

   Next i
   
   '＝＝＝＝＝＝＝＝＝＝＝＝＝＝SQLの後処理
   If Not db Is Nothing Then               'オブジェクトが存在する場合
   'コネクション状態がオープンの場合
       If db.State = adStateOpen Then
           db.Close                        'DBクローズ
       End If
       Set db = Nothing                    'オブジェクト破棄
   End If

Exit Sub

'エラーの場合 ErrorHandler:

   Call MsgBox("エラー" & Err.Number & Chr(13) & Err.Description, vbCritical)

End Sub

Function makeSQL() As Variant ' SQL文作成：配列にテキストを入れる

   Sheets("dat").Select
   Dim str() As String                         'SQL文を入れる配列
   Dim i As Integer
   Dim TABLE As String
   TABLE = "syaintable"
   i = 2                                               '１行目は見出しなので
   While Cells(i, 1).Value <> ""
       ReDim Preserve str(i - 1)
       str(i - 1) = "insert into " & TABLE & " ( id  ,  name ,  gender ,  email )  values (" _
       & Cells(i, 1).Value & " , '" _
       & Cells(i, 2).Value & "' , '" _
       & Cells(i, 3).Value & "' , '" _
       & Cells(i, 4).Value _
       & "' );"
        i = i + 1
  Wend
  makeSQL = str

' 確認のためシートに書き出す。

   For i = 1 To UBound(str)
       Cells(i + 1, 5).Value = str(i)
   
   Next i
  
  

End Function