Bolding column headers after exporting from Access into Excel

Lifeseeker

Registered User.
Local time
Yesterday, 20:31
Joined
Mar 18, 2011
Messages
273
Hi there,

I would like to export from access a recordset into Excel and bold the column headers.

My current code works for the most part, except for the bolding. Could anyone take a look at it?

You run the code in Access module and the code does the following:
1) checks to see if the excel file is open
2) if excel file not open, it opens the file, clears existing records, and starts copying and pasting new recordset into the RAW worksheet
3) it is then supposed to bold the column headers.

bolding is not working, and I feel like i'm just missing something small but don't know what it is.


Code:
Sub TestFileOpened()
    Dim lastRow As Long
    ' Test to see if the file is open.
    If IsFileOpen("c:\\test2003.xls") Then
        ' Display a message stating the file in use.
        MsgBox "File already in use!"
    Else
        ' Display a message stating the file is not in use.
        MsgBox "File not in use!"
        'Open the excel file
        Dim xlApp As Object
        
        Set xlApp = CreateObject("Excel.Application")
       
        xlApp.Visible = True
        xlApp.Workbooks.Open "C:\\TEST.xls", True, False
        lastRow = xlApp.activesheet.usedrange.rows.Count
          
        'delete existing records
         Dim i As Long
         Dim j As Long
  
        For i = 1 To lastRow
          For j = 1 To 15
            xlApp.worksheets("RAW").cells(i, j).Value = ""
          Next j
        Next i
    End If
   
    
    'start exporting data
     'start exporting headers
    Dim intcolIndex As Integer
    Dim rs As Recordset
   
    Set rs = CurrentDb.OpenRecordset("Select * from qry_Master_export")
   
    xlApp.Range("A2").CopyFromRecordset rs
   
    For intcolIndex = 0 To rs.Fields.Count - 1
    xlApp.Range("A1").Offset(0, intcolIndex).Value = rs.Fields(intcolIndex).Name
   
Next
    xlApp.activeworkbook.Save
   
    'format the files in Excel
    xlApp.ActiveWindow.splitcolum = 0
    xlApp.ActiveWindow.splitrow = 1
    xlApp.ActiveWindow.freezepanes = True
   
    'bold col headers
    xlApp.worksheets("RAW").Select
    rows("1:1").Select
    selection.Font.Bold = True
 
    Set xlApp = Nothing
   
End Sub
 
' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.
 
Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer
 
    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.
 
    ' Check to see which error occurred.
    Select Case errnum
 
        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False
 
        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True
 
        ' Another error occurred.
        Case Else
            Error errnum
    End Select
 
End Function

Could anybody assist?

Thanks
 

Attachments

Change it:
Code:
 rows("1:1").Select
 selection.Font.Bold = True
To:
Code:
xlApp.rows("1:1").Select
xlApp.selection.Font.Bold = True
Why are you testing if one Excel file is open, if you open another one, (different names)?
 

Users who are viewing this thread

Back
Top Bottom