ADODB Bağlantısında Hata!

Private Sub CommandButton1_Click()
   
    On Error GoTo Hata:
   
    Dim rs As ADODB.Recordset
    Dim cn As ADODB.Connection
    Dim cmdObj As ADODB.Command
    Dim qf As Object
   
    Dim aqy As QueryTable
    Dim SqlSTR As String
    Dim Sql As String

    Set cn = New ADODB.Connection
     
    kod = Trim(Range("b4"))
   
    Sheets("001").Select
    Range("b4")
   
        cn.Open "Provider=sqloledb;Data Source=XXXX; Initial Catalog=XXXDB; User Id=XXXXXX;Password=XXXXXXXX"
       
        Sql = "SELECT "
        Sql = Sql & "NAME+' '+NAME3 FROM LG_XXX_ITEMS WHERE CODE='" & kod & "'"

        Set rs = New ADODB.Recordset
        rs.CursorLocation = adUseClient
        rs.CursorType = adOpenForwardOnly
        rs.Open Sql, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
        Range("B7").CopyFromRecordset rs
        rs.Close
        Set rs = Nothing
           
           End If
       
       
        If Err.Number <> 0 Then
   
Hata:
            MsgBox " Hata : " & Err.Description & " !.", vbCritical, "Hata"
        Exit Sub
    End If
    On Error GoTo 0
End Sub

cn.Open Server=