如何修改VBA宏为每次生成的Excel文件添加指定表头

Hey there! Let's tackle that missing header problem in your VBA macro. The core issue with your original code is that it uses a plain text file (disguised as .xls) which can't handle formatting like bold text. To fix this, we'll switch to using Excel's object model to create a proper workbook, so we can add those bold headers and structure your data correctly.

Your Original Code (for reference) #

Sub TEXT()
 Dim cn As New ADODB.Connection
 Dim rs As New ADODB.Recordset
 Dim strCon, strSQL As String
 Dim MRC As Variant
 strCon = "some_string_connection"
 MRC = "" & Worksheets("SQL Text").Range("D4").Value & ""
 strSQL = MRC 'Sql Query
 Sheets("Summary").Select
 With ActiveWorkbook.Connections("Connection1").OLEDBConnection
 .CommandText = HR
 .CommandType = xlCmdSql
 End With
 ActiveWorkbook.Connections("Connection1").Refresh
 Folder = "U:\" 'Path in U drive
 Filename = "Filename" & ".xls"
 fpath = Folder & Filename
 cn.Open strCon
 cn.CommandTimeout = 0
 rs.ActiveConnection = cn
 rs.Open strSQL
 Set fs = CreateObject("Scripting.FileSystemObject")
 Set A = fs.CreateTextFile(fpath)
 A.Write (rs.GetString(adClipString, , , vbCrLf, ""))
 rs.Close
 cn.Close
 Set cn = Nothing
End Sub

Modified Code with Bold Headers #

This version creates a real Excel workbook, adds your 5 bold headers, and loads the SQL data starting from row 2:

Sub ExportWithFormattedHeaders()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim strCon, strSQL As String
    Dim MRC As Variant
    Dim folderPath As String, fileName As String, fullPath As String
    Dim xlApp As Object, xlWB As Object, xlWS As Object
    Dim headerNames As Variant
    Dim colIndex As Integer
    
    ' Setup connection string and SQL query
    strCon = "some_string_connection"
    MRC = Worksheets("SQL Text").Range("D4").Value
    strSQL = MRC ' Grab query from worksheet
    
    ' Optional: Keep this if you need to refresh the Summary sheet connection
    ' Fixed typo: Changed undefined "HR" to strSQL
    Sheets("Summary").Select
    With ActiveWorkbook.Connections("Connection1").OLEDBConnection
        .CommandText = strSQL
        .CommandType = xlCmdSql
    End With
    ActiveWorkbook.Connections("Connection1").Refresh
    
    ' Define output file path
    folderPath = "U:\"
    fileName = "Filename" & ".xls"
    fullPath = folderPath & fileName
    
    ' Connect to SQL Server and run the query
    cn.Open strCon
    cn.CommandTimeout = 0
    rs.Open strSQL, cn
    
    ' Create a new Excel instance (hidden from view)
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    Set xlWB = xlApp.Workbooks.Add
    Set xlWS = xlWB.Sheets(1)
    
    ' Add bold headers to row 1
    headerNames = Array("column_header1", "column_header2", "column_header3", "column_header4", "column_header5")
    For colIndex = LBound(headerNames) To UBound(headerNames)
        xlWS.Cells(1, colIndex + 1).Value = headerNames(colIndex)
        xlWS.Cells(1, colIndex + 1).Font.Bold = True
    Next colIndex
    
    ' Load SQL data starting from row 2
    If Not rs.EOF Then
        xlWS.Range("A2").CopyFromRecordset rs
    End If
    
    ' Save the workbook and clean up resources
    xlWB.SaveAs fullPath, FileFormat:=xlExcel8 ' Format compatible with .xls
    xlWB.Close SaveChanges:=False
    xlApp.Quit
    
    ' Clean up database objects
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing
    Set xlWS = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing
    
    MsgBox "File saved successfully to: " & fullPath, vbInformation
End Sub

What Changed & Why: #

• Switched to Excel Object Model: Instead of writing a plain text file, we create a genuine Excel workbook, which lets us apply formatting like bold text.
• Added Header Array: We defined your 5 headers in an array, looped through them to populate row 1, and set each cell's font to bold.
• Used CopyFromRecordset: This is a far more efficient way to load SQL data into Excel than writing text strings manually.
• Fixed Typo: Your original code had .CommandText = HR where HR was undefined—we changed that to strSQL to match your query variable.
• Proper Cleanup: We closed all connections and released objects to prevent memory leaks and leftover Excel processes running in the background.

内容的提问来源于stack exchange，提问作者sat