Losing header row when importing to Excel using ADO

[matt_d]

Hi all,

I'm trying to use ADO to import the results of an SQL query into and Excel spreadsheet. All works fine except it's not pulling the header row back. From browsing the the net it seems I need a 'HDR=Yes' somewhere but I can't suss out where. Can anyone help? Code below:

Part one

Sub GetOrderDetail()
    
    Dim userid As String
    Dim password As String
    Dim SQLS As String
    Dim destination As String
    
    Worksheets("Order Sheet DETAIL").Range("B8:S20009").ClearContents
              
    userid = "NONFOODFIN"
    password = "nonfoodfin"
        SQLS = " exec DXWI_PROD_NONFOODFIN_PLAY_PEN.UR77_FWK06_Order_Detail; "
    destination = [DownloadOrderDetail].Address
            
    Call ADOExecDataGet(userid, password, SQLS, destination)
           
End Sub

Part two (the ADO bit)

Sub ADOExecDataGet(userid, password, SQLS, destination)

  Dim Rs As New ADODB.Recordset
  Dim TerConnection As New ADODB.Connection
    
    'ensure RecordSet and Connection are closed
    On Error Resume Next
    Rs.Close
    
    On Error Resume Next
    TerConnection.Close

    'ODBC Driver for Teradata
    myUsername = userid
    myPassword = password
    TerConnection.Open "DSN=DW Master;" & _
                       "Uid=" & userid & ";" & _
                       "Pwd=" & password & ";"

    TerConnection.CommandTimeout = 0
    Set Rs = TerConnection.Execute(SQLS)
    'Rs.Close
    'TerConnection.Close
    
    'Import data to destination cell
    Range(destination).CopyFromRecordset Rs
         
End Sub

Thanks in advance,

 

[Richard Schollar]

Hi Matt

I can think of a way of doing it - is 'destination' a single cell? Eg like B1 or something?

Best regards

Richard

 

[matt_d]

Hi Richard,

Yes, it is.

Matt

 

[Richard Schollar]

Try this amended code (only the second sub has changed):

Sub ADOExecDataGet(userid, password, SQLS, destination) 

  Dim Rs As New ADODB.Recordset 
  Dim TerConnection As New ADODB.Connection 
  Dim i as Integer
    
    'ensure RecordSet and Connection are closed 
    On Error Resume Next 
    Rs.Close 
    
    On Error Resume Next 
    TerConnection.Close 

    'ODBC Driver for Teradata 
    myUsername = userid 
    myPassword = password 
    TerConnection.Open "DSN=DW Master;" & _ 
                       "Uid=" & userid & ";" & _ 
                       "Pwd=" & password & ";" 

    TerConnection.CommandTimeout = 0 
    Set Rs = TerConnection.Execute(SQLS) 
    'Rs.Close 
    'TerConnection.Close 
    
'Import Headers
For i = 0 to Rs.Fields.Count-1
   Range(destination).Offset(0,i) = Rs.Fields(i).Name
Next i
    'Import data to destination cell 
    Range(destination).Offset(1,0).CopyFromRecordset Rs 
          
End Sub

Note this does rely on Destination being a single-celled reference such as $A$2 (not $A$2:$Z$1000).

Best regards

Richard

 

[matt_d]

Thanks Richard. Worked like a charm.

Matt