OK-PC

Function GetDBConnection() As ADODB.Connection
    On Error GoTo ErrHandler

    Dim serverName As String
    Dim dbName As String
    Dim userID As String
    Dim pass As String

    ' 接続情報を記入
    serverName = "サーバー名"
    dbName = "データベース名"
    userID = "ユーザー名"
    pass = "パスワード"

    ' グローバル変数 g_cnn を接続オブジェクトとして使用
    With g_cnn
        .Provider = "MSOLEDBSQL"
        .Properties("Data Source").Value = serverName
        .Properties("Initial Catalog").Value = dbName
        .Properties("User ID").Value = userID
        .Properties("Password").Value = pass
        .CommandTimeout = 0
        .ConnectionTimeout = 0
        .Open
    End With

    If Not g_cnn Is Nothing Then
        Debug.Print Now & " サーバー接続成功：" & serverName
    End If

    Set GetDBConnection = g_cnn
    Exit Function

ErrHandler:
    MsgBox "データベースへの接続に失敗しました。" & vbCrLf & "再度お試しください。", vbExclamation
    Set GetDBConnection = Nothing
End Function

Sub CloseDBConnection(ByRef g_cnn As ADODB.Connection)
    On Error Resume Next

    If Not g_cnn Is Nothing Then
        If g_cnn.State <> adStateClosed Then
            g_cnn.Close
            Debug.Print Now & " 接続解除"
        End If
        Set g_cnn = Nothing
    End If

    On Error GoTo 0
End Sub