2017-03-02 294 views
1

我需要添加表頭以包含在我的VBA代碼中,該代碼已連接到SQL。代碼正在工作(因爲它正在將新的工作表上的SQL結果吐出),但它並沒有抓住頭部。VBA包含SQL查詢標題

有人可以幫忙嗎?

Sub SpectrumADGroupMapping() 

    'Start Declarations' 
    Dim Cn As ADODB.Connection 
    Dim rs As ADODB.Recordset 

    'Connection string to SQL server/DB (Windows Auth) 
    Set Cn = New ADODB.Connection 
    Cn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Data Source=TEST;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=TESTPC;Use Encryption for Data=False;Tag with column collation when possible=False;Initial Catalog=TESTDBNAME" 
    Cn.Open 

    Set and Execute SQL Command 
    Set rs = New ADODB.Recordset 
    rs.ActiveConnection = Cn 
    rs.Open "Select top 50* from TestTable order by creationDate desc" 

    'Copy Data to Excel 
    Worksheets.Add(After:=Worksheets(1)).Name = "TestWorkSheet" 
    Range("A2").CopyFromRecordset rs 

    Cn.Close 

End Sub 

回答

0

像下面這樣的東西應該可以工作。 (我剛剛把它拖了我的電子表格中的一個 - 只是改變了名稱,以保護無辜者。)

' Write out the Field names as column headings 
Dim c As Long 
For c = 1 To rs.Fields.Count 
    With Worksheets("TestWorkSheet").Cells(1, c) 
     .Value = rs.Fields(c - 1).Name 

     'The rest is just how we format the headings - leave it in or take it out 
     .Font.Bold = True 
     .Interior.Pattern = xlSolid 
     .Interior.PatternColorIndex = xlAutomatic 
     .Interior.ThemeColor = xlThemeColorDark1 
     .Interior.TintAndShade = -0.149998474074526 
     .Interior.PatternTintAndShade = 0 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlCenter 
     .WrapText = True 
     'End of formatting of headings 

    End With 
Next c 

將這些代碼你Range("A2").CopyFromRecordset rs前行(你真的應該代碼爲Worksheets("TestWorkSheet").Range("A2").CopyFromRecordset rs - 它總是一個當您使用RangeCells等時,您是否有資格使用哪個工作表)。