【ExcelVBA】SQLServer接続・SQL実行

Option Explicit
'################################################################
'##
'##     DB接続パーツ
'##
'################################################################
Public db As ADODB.Connection   'DBコネクション保持
'/////////////////////////////////////////////////////////
'//
Public Sub CheckDbConnection()
'//
'/////////////////////////////////////////////////////////
    Dim ret As Integer
    ret = DBOpen()
    If ret = 0 Then
        MsgBox "正常に接続できました", vbOKOnly + vbInformation, "成功"
        Call DBClose
    Else
        'DBOpenでエラーメッセージを出力しているため、ここでは何もしない
    End If
End Sub

'/////////////////////////////////////////////////////////
'//'DBのコネクションオープン
Public Function DBOpen() As Integer
'//
'// 戻値:終了コード     0:正常終了
'//
'/////////////////////////////////////////////////////////
    Dim OpenFlag As Boolean
    OpenFlag = False
    
    If db Is Nothing Then
        'オブジェクトがNothingの場合、オブジェクト生成する
        Set db = New ADODB.Connection
        db.CursorLocation = adUseClient
        OpenFlag = True
    Else
        'オブジェクトがNothingでない場合で、コネクション状態が閉じている場合
        If db.State = adStateClosed Then
            OpenFlag = True
        End If
    End If
    
    'OpenFlagがオンの場合
    If OpenFlag = True Then
        'Connection Stringの生成
        Dim st As String
        Dim m_ServerName As String
        Dim m_DatabaseName As String
        Dim m_UserID As String
        Dim m_Password As String
        
        '★要変更
        m_ServerName = Sheets("0-1").Cells(5, 34).Value
        m_DatabaseName = Sheets("0-1").Cells(6, 34).Value
        m_UserID = Sheets("0-1").Cells(7, 34).Value
        m_Password = Sheets("0-1").Cells(8, 34).Value
        
        st = "Provider=SQLOLEDB;Data Source=" & m_ServerName & ";Initial Catalog=" & m_DatabaseName & ";" & _
             "User Id=" & m_UserID & ";Password=" & m_Password & ";"
        
        'DBオープン
        On Error GoTo ErrHandler1
        db.Open st
        On Error GoTo 0
    End If
    
    DBOpen = 0
    Exit Function
        
ErrHandler1:
    MsgBox "データベース接続でエラーが発生しました。設定を確認してください。", vbOKOnly + vbExclamation
    DBOpen = 99
    Exit Function
        
End Function

'/////////////////////////////////////////////////////////
'//'DBのコネクションクローズ
Public Function DBClose()
'//
'/////////////////////////////////////////////////////////
    'オブジェクトがNothingでない場合
    If Not db Is Nothing Then
        'DBクローズ
        db.Close
        Set db = Nothing
    End If
End Function

'/////////////////////////////////////////////////////////
'//
Public Sub SQLServer_SELECT実行()
'//
'/////////////////////////////////////////////////////////

    '変数設定
    Dim ret as Integer
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    Dim DeleteStartRow As Integer
    Dim DeleteEndRow As Integer
    strSQL = "SQL文"
    StartRow = 3
    EndRow = Cells(Rows.Count, 1).End(xlUp).Row

    'DBOpen
    ret = DBOpen()
    If ret <> 0 Then
        'DBオープンエラー。エラーメッセージはDBOpen内で出力しているため、ここでは何もせずにExitする
        Exit Sub
    End If

    '初期化
    Range(Rows(StartRow), Rows(EndRow)).Clear

    'データ取得・貼り付け
    Set rs = New ADODB.Recordset
    rs.Open strSQL, db, adOpenStatic, adLockReadOnly
    If Not (rs.EOF) Then
        Cells(StartRow, 1).CopyFromRecordset rs
    End If
        
    'DBClose
    Call DBClose

  ErrHandler1:
      Call DBClose
      MsgBox "SQL結果がありません。SQL文を見直してください。"
      Exit Sub
  
End Sub

'/////////////////////////////////////////////////////////
'//
Public Sub SQLServer_SELECT実行()
'//
'/////////////////////////////////////////////////////////

    '変数設定
    Dim ret as Integer
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    strSQL = "SQL文"

    'DBOpen
    ret = DBOpen()
    If ret <> 0 Then
        'DBオープンエラー。エラーメッセージはDBOpen内で出力しているため、ここでは何もせずにExitする
        Exit Sub
    End If

    'データ更新
    Set rs = New ADODB.Recordset
    rs.Open strSQL, db, adOpenStatic, adLockReadOnly
    rs.Execute strSQL
        
    'DBClose
    Call DBClose

ErrHandler1:
    Call DBClose
    MsgBox "更新に失敗しました。SQL文を見直してください。"
    Exit Sub

End Sub