Função VBA para buscar dados no SQL Server

[jhoe1205]

Bom dia senhores,

Tenho uma planilha de Excel que busca em um banco SQL Server, os dados das contas telefônicas, montei uma função VBA mas esta está apresentando o seguinte erro:

"Erro em tempo de execução '9'"

"Subscrito fora do intervalo" e aponta a linha "With Worksheets("Importar").ListObjects(1)" no código mostrado a baixo.

Sub ImportaTarifador()
    
    Dim sql, DataI, DataF As String
    
    Dim Conexao As ADODB.Connection
    Set Conexao = New ADODB.Connection
    DiaI = Right(Names("DiaInicial").Value, Len(Names("DiaInicial").Value) - 1)
    DiaF = Right(Names("DiaFinal").Value, Len(Names("DiaFinal").Value) - 1)
    
    DataI = DiaI & "/" & Range("E4").Value & "/" & Range("h4").Value
    
    If Range("E4").Value = 12 Then
        DataF = 1 & "/" & DiaF & "/" & Range("h4").Value + 1
    Else
        DataF = DiaF & "/" & Range("e4").Value + 1 & "/" & Range("h4").Value
    End If
    
    sql = "SELECT L.datahora, L.ramal, L.nrodisc, L.durminutos, L.DURSEGUNDOS,    L.VALORCUSTO, R.CODCENCUS AS SETOR  FROM TARLIGACOES L INNER JOIN TARCADRAMAL R ON L.RAMAL = R.RAMAL WHERE L.datahora BETWEEN '?Inicial' AND    '?Final 23:59:59' GROUP BY L.datahora, L.ramal, L.nrodisc, L.durminutos, L.DURSEGUNDOS, L.VALORCUSTO, R.CODCENCUS ORDER BY L.DATAHORA, L.RAMAL"
    'sql = "SELECT L.datahora, L.ramal, L.nrodisc, cast(L.durminutos AS varchar(3))    + ':' + cast(L.DURSEGUNDOS AS varchar(3)) AS DURACAO,    L.VALORCUSTO, R.CODCENCUS AS SETOR  FROM dá.TARLIGACOES L INNER JOIN dá.TARCADRAMAL R ON L.RAMAL = R.RAMAL WHERE L.datahora BETWEEN '4/11/2007' AND    '5/10/2007 23:59:59' GROUP BY L.datahora, L.ramal, L.nrodisc, L.durminutos, L.DURSEGUNDOS, L.VALORCUSTO, R.CODCENCUS ORDER BY L.DATAHORA, L.RAMAL"
    
    sql = Replace(sql, "?Inicial", DataI)
    sql = Replace(sql, "?Final", DataF)
    
    Debug.Print sql
        
    With Worksheets("Importar").ListObjects(1)
        .ShowTotals = False
        .Range.AutoFilter Field:=1
        .Range.AutoFilter Field:=2
        .Range.AutoFilter Field:=3
        .Range.AutoFilter Field:=4
        .Range.AutoFilter Field:=5
        .Range.AutoFilter Field:=6
        .Range.AutoFilter Field:=7
        
        If .ListRows.Count > 0 Then
            .DataBodyRange.Delete
        End If
        
    End With
    
    With Conexao
        '.Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=XXX; Password=XXX;Initial Catalog=windes4;Data Source=SRV-DB1;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=WKSFIN01;Use Encryption for Data=False;Tag with column collation when possible=False"
        .Open
        Set Rs = .Execute(sql)
        Worksheets("Importar").Range("B8").CopyFromRecordset Rs
    End With
    
     If Worksheets("Importar").ListObjects(1).ListRows.Count > 0 Then
         With Worksheets("Importar").ListObjects(1).DataBodyRange
            .Columns(1).NumberFormat = "dd/mm/yy hh:mm;@"
            .Columns(1).HorizontalAlignment = xlCenter
            .Columns(2).NumberFormat = "#,##0_);(#,##0)"
            .Columns(2).HorizontalAlignment = xlCenter
            .Columns(4).HorizontalAlignment = xlCenter
            .Columns(9).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
            .Columns(7).Replace _
                    What:="1", Replacement:="2570", _
                    SearchOrder:=xlByColumns, LookAt:=xlWhole
                    
            .Columns(8).FormulaR1C1 = _
                "=IF(RC[-1]<>"""",VLOOKUP(RC[-1],Centros,3,FALSE),"""")"
        End With
        
        Worksheets("Importar").ListObjects(1).ShowTotals = True
        
    End If
    
    Set Rs = Nothing
    Conexao.Close
    Set Conexao = Nothing


End Sub

Já fiz diversos testes, como mudar a string de conexão do banco, mudar o nome da planilha mudar o usuário de conexão dentre várias outras mas nada funcionou.

Agradeço imensamente a quem puder ajudar.