VBA CÓDIGO

[BRUNO CELIDONIO]

Bom dia !

 

estou tentando fazer uma conexão SQL via VBA mas chega uma hora  que apresenta o seguinte erro :

 

 na seguinte linha :

Do While Not linha.EOF

estou tentando resolver a um tempo e não estou conseguindo segue abaixo o CÓDIGO:

 

Sub busca()
   
   'Variaveis de uso do processo
    Dim conn As New ADODB.Connection
    Dim linha As New ADODB.Recordset
    Dim rng As Range
    Dim campo As ADODB.Field
    Dim C As Integer
    Dim Arquivo As Workbook
    Dim Plan As String
    
   'Variaveis de acesso e consulta ao banco de dados
    Dim usuario As String
    Dim senha As String
    Dim servidor As String
    Dim banco As String
    Dim sql As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

    usuario =
    senha = 
    servidor = 
    banco = 
    sql = Sheets("DATA").Range("A4")
    
    conn.ConnectionString = "Provider=SQLNCLI11;" & _
    "Uid=" & usuario & ";" & _
    "Server=" & servidor & ";" & _
    "Database=" & banco & ";" & _
    "Pwd=" & senha
    
    conn.CommandTimeout = 0
    conn.ConnectionTimeout = 0
    conn.Open
    
    Set linha = conn.Execute(sql)
    
     Sheets("Planilha2").Activate
    
    Set rng = Sheets("Planilha2").Range("B13") '
    
    Worksheets("Planilha2").Range("B13:H1048576").ClearContents
    
    C = 0
    
For Each campo In linha.Fields
        rng.Offset(0, C).Value = campo.Name
        rng.Offset(0, C).Font.Bold = True
        C = C + 1
    Next
    
         
    Set rng = Sheets("Planilha2").Range("B14")
    Do While Not linha.EOF
        
        C = 0
        For Each campo In linha.Fields
            rng.Offset(0, C).Value = campo.Value
            C = C + 1
        Next
        Set rng = rng.Offset(1, 0)
        linha.MoveNext
    Loop
  
  conn.Close

    ActiveSheet.Range("A1").Select
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.Calculate

Sheets("CAPA").Range("A1").Select

'MsgBox "Pesquisa finalizada!"

End Sub
 

obg a todos.

 

 

Editado Janeiro 5, 2022 por BRUNO CELIDONIO