Setting Connection & VPN

[Jeffs23]

I am getting two errors when I attempt to run my macro:

"Connection not properly defined"

and

"The connection cannot be used to perform this operation. It is either closed or invalid in this context."

I need to set my connection to a specific server I access via a VPN. Can someone point me to where I need to Edit my code below?

My Module:

Public Sub ExecuteYourCommand()
 
    On Error GoTo ErrHand
 
    Dim cnn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim param As ADODB.Parameter
    Dim rst As ADODB.Recordset
    
    Dim bParamStartDateFound As Boolean
    Dim bParamEndDateFound As Boolean
    
    Dim wksParams As Worksheet, wksOutput As Worksheet
' adjust as required
    Set wksParams = Sheets("Billing Chart")
    Set wksOutput = Sheets("MTD")
    bParamStartDateFound = False
    bParamEndDateFound = False
    
    Dim mySqlProvider As clsSQLProvider
    Set mySqlProvider = New clsSQLProvider
    
    Set cnn = mySqlProvider.CreateConnection
    
    Set cmd = New ADODB.Command
    cmd.ActiveConnection = cnn
    
    With cmd
        .CommandType = adCmdStoredProc
        .CommandText = "cusExcelMTD"
    End With
    
    If cmd.Parameters.Count > 0 Then
    
        For Each param In cmd.Parameters
        
            Select Case param.Name
           
            Case "@StartDate"
                        
                param.Value = wksParams.Range("A1")
                bParamStartDateFound = True
                       
            Case "@EndDate"
                        
                param.Value = wksParams.Range("B1").Value
                bParamEndDateFound = True
                       
            End Select
        
        Next
    
    End If
    
    If bParamStartDateFound = False Then
        Set param = New ADODB.Parameter
        With param
            .Name = "@StartDate"
            .Type = adDate
'            .Size = 260
            .Value = wksParams.Range("A1").Value
        End With
        cmd.Parameters.Append param
    End If
 
 
    If bParamEndDateFound = False Then
        Set param = New ADODB.Parameter
        With param
            .Name = "@EndDate"
            .Type = adDate
'            .Size = 260
            .Value = wksParams.Range("B1")
        End With
        cmd.Parameters.Append param
    End If
    
    Set rst = cmd.Execute
    wksOutput.Range("A2").CopyFromRecordset rst
 
ExitHere:
 
    On Error Resume Next
    
    If Not cnn Is Nothing Then If Not cnn.State = adStateClosed Then cnn.Close: Set cnn = Nothing
    
    Err.Clear
 
    Exit Sub
 
ErrHand:
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation
    Resume ExitHere
 
    
End Sub

My Class Module:

Public Function CreateConnection(Optional ByVal _
        ServerName As String = _
        "http://10.10.100.7/centricity:9080", Optional ByVal Database As String = "UHCI") As ADODB.Connection

'Returns an ADODB Connection object to Outlook 2003 Business Contact _

'Manager installed locally

'---------------------------------

Dim cn As New ADODB.Connection

     On Error GoTo ErrHand

     With cn
        .ConnectionTimeout = 5
        .ConnectionString = _
            "Provider=SQLOLEDB.1;Integrated Security=SSPI;Trusted Connection=True;" & _
            "Persist Security Info=False;" & _
            "Initial Catalog=" & Database & ";" & _
            "Data Source=" & ServerName & "; ConnectionTimeout=5"


        .Open

    End With

    Set CreateConnection = cn

ExitHere:

    On Error Resume Next

    Err.Clear

    Exit Function

ErrHand:

    Set CreateConnection = Nothing

    MsgBox "Connection not properly defined.", vbExclamation
    
    If Not cn Is Nothing Then If Not cn.State = adStateClosed Then cn.Close: Set cn = Nothing

    Resume ExitHere

End Function