Jump to content
Fórum Script Brasil
  • 0

VBA CÓDIGO


BRUNO CELIDONIO
 Share

Question

Bom dia !

 

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

 

image.png.f9cc5393de3e6d6c1d75bc6a6f5bc0ea.png

 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.

 

 

Edited by BRUNO CELIDONIO
Link to comment
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share



  • Forum Statistics

    • Total Topics
      150.2k
    • Total Posts
      647.5k
×
×
  • Create New...