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.
Could anybody assist?
Thanks
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