Format First Row of Excel Spreadsheet From Access

JohnLee

Registered User.
Local time
Today, 03:15
Joined
Mar 8, 2007
Messages
692
Good morning Folks,

I'm looking for some help with my code. I have created the following function from reading various bits of information in this forum, but have got stuck on how to format the first row in an Excel Spreadsheet, and this is where I need help

Code:
[FONT=Times New Roman][COLOR=blue]Function[/COLOR] ExportToExcel()[/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] ExcelFile [COLOR=blue]As String[/COLOR]         [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] ExcelWorksheet [COLOR=blue]As String[/COLOR]    [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] FEDB [COLOR=blue]As String[/COLOR]              [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] QueryName [COLOR=blue]As String[/COLOR]         [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] objDB As Database           [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] MyDate                      [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] MyWeekDay                   [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]MyDate = [COLOR=blue]Date[/COLOR] [/FONT]
[FONT=Times New Roman]MyWeekDay = Weekday(MyDate) 'MyWeekDay represents the current day in the week[/FONT]
[FONT=Times New Roman] [/FONT]
[COLOR=green][FONT=Times New Roman]'If today is Friday then[/FONT][/COLOR]
[FONT=Times New Roman][COLOR=blue]If[/COLOR] MyWeekDay = 4 [COLOR=blue]Then[/COLOR][/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    ExcelFile = "G:\Biasi\WC" & "_" & Format(Date - 4, "ddmmyy") & ".xls" [/FONT]
[FONT=Times New Roman]    ExcelWorksheet = "WC " & Format(Date - 4, "ddmmyy")                   [/FONT]
[FONT=Times New Roman]    FEDB = "H:\John Lee\eFlowStatsFrontEnd.mdb"                           [/FONT]
[FONT=Times New Roman]    QueryName = "qryExportToExceltblBiasi"                                [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Set[/COLOR] objDB = OpenDatabase(FEDB)  [/FONT]
[FONT=Times New Roman] [/FONT]
[COLOR=green][FONT=Times New Roman]    'Excute the creation of the Excel file[/FONT][/COLOR]
[FONT=Times New Roman]    objDB.Execute "Select*Into[Excel 8.0;Database=" & ExcelFile & "].[" & ExcelWorksheet & "] From " & "[" & QueryName & "]"[/FONT]
[FONT=Times New Roman]    objDB.Close 'Close the eFlowStatsFrontEnd database[/FONT]
[FONT=Times New Roman]    [COLOR=blue]Set[/COLOR] objDB = [COLOR=blue]Nothing[/COLOR] [/FONT]
[FONT=Times New Roman]    [/FONT]
[FONT=Times New Roman]    DoCmd.OpenQuery "qrpApptblBiasiProcessHistoryToLongTerm", acNormal, acEdit[/FONT]
[FONT=Times New Roman]    [/FONT]
[FONT=Times New Roman]    DoCmd.OpenQuery "qryDeltblBiasiProcessHistory", acNormal, acEdit[/FONT]
[FONT=Times New Roman]    [/FONT]
[COLOR=blue][FONT=Times New Roman]End If[/FONT][/COLOR]
[FONT=Times New Roman] [/FONT]
[COLOR=blue][FONT=Times New Roman]End Function[/FONT][/COLOR]

I've found this example, but not sure how to adapt it to my needs and where in should fit within the above code:


Code:
ObjXL.WorkbooksOpen ()
with ObjXL
             .Worksheets(worksheetname).Rows("1:1").Font.Bold = True
             .Columns("A:Z").Autofit
             .Save
             .Workbooks.Close
End With

Your assistance would be most appreciated.

John
 
Try this at end of code:
Code:
Dim objExcel
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Open [FONT=Times New Roman]"G:\Biasi\WC" & "_" & Format(Date - 4, "ddmmyy") & ".xls" [/FONT]
Set objsheet = objExcel.ActiveWorkbook.Worksheets(1)

With objsheet
    .Rows("1:1").Select
    .Selection.Font.Bold = True 'may have to check this not sure if property is right
    .Columns("A:Z").Select
    .Columns("A:Z").EntireColumn.AutoFit
End With
 
Good day and a happy new year to you spentgeezer and Boblarson, I've been on holiday since I first posted my question, thanks for both of your responses, I will be trying them out in due course.

John
 
Hi Guys,

I've tried both of your code samples, and I keep getting a message saying that the method is not support for the following code part:

Spents code:

Code:
.Selection.Font.Bold = True

and in Bobs code :

Code:
ApXL.Selection.Font.Bold = True

I have the following references set:

Visual Basic for Applications
Microsoft Access 9.0 Object Library
OLE Automation
Microsoft ActiveX Data Objects 2.1 Library
Microsoft Scripting Runtime
Microsoft DAO 3.6 Object Library
Microsoft Excel 11.0 Object Library

I'm guessing that something is missing from the references which is causing the method not to be supported. Any suggestions would be appreciated.

John
 
Hi guys,

Just thought I'd update you on my progress, as I have now got what I was looking to achieve. My code now looks like this, just in case there is anyone else out there looking to do something similar:

Code:
[SIZE=3][FONT=Times New Roman]Function ExportToExcel()[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3]DoCmd.Echo False, "Running Program" [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]DoCmd.Hourglass True [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]DoCmd.SetWarnings False [/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]Dim ExcelFile As String         [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]Dim ExcelWorksheet As String    [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]Dim FEDB As String              [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]Dim QueryName As String         [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]Dim objDB As Database           [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]Dim MyDate                      [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]Dim MyWeekDay                   [/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]MyDate = Date [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]MyWeekDay = Weekday(MyDate) [/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]If MyWeekDay = 6 Then[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    ExcelFile = "G:\Biasi\WC" & "_" & Format(Date - 4, "ddmmyy") & ".xls" [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    ExcelWorksheet = "WC " & Format(Date - 4, "ddmmyy")                   [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    FEDB = "H:\John Lee\eFlowStatsFrontEnd.mdb"                           [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    QueryName = "qryExportToExceltblBiasi"                                [/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    Set objDB = OpenDatabase(FEDB)  [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    If Dir(ExcelFile) <> "" Then Kill ExcelFile [/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]    objDB.Execute "Select*Into[Excel 8.0;Database=" & ExcelFile & "].[" & ExcelWorksheet & "] From " & "[" & QueryName & "]"[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    objDB.Close [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    Set objDB = Nothing [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    DoCmd.OpenQuery "qryApptblBiasiProcessHistoryToLongTerm", acNormal, acEdit[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    DoCmd.OpenQuery "qryDeltblBiasiProcessHistory", acNormal, acEdit[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]End If[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]Dim ObjExcel [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]Set ObjExcel = CreateObject("Excel.Application") [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]ObjExcel.Visible = True [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]ObjExcel.Workbooks.Open "G:\Biasi\WC" & "_" & Format(Date - 4, "ddmmyy") & ".xls"[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]Set Objsheet = ObjExcel.ActiveWorkbook.Worksheets(1)[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]With Objsheet[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    .Rows("1:1").Font.Bold = True[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    .Columns("A:Z").Select[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    .Columns("A:Z").EntireColumn.AutoFit[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]End With[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3]ObjExcel.ActiveWorkbook.Save [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]ObjExcel.ActiveWorkbook.Close [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]ObjExcel.Quit [/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3] [/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]DoCmd.Echo True, "Program End" [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]DoCmd.Hourglass False [/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]DoCmd.SetWarnings True [/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]End Function[/SIZE][/FONT]

Thanks for your help guys.

John
 
Out of curiosity what is the name of the accdb/mdb you are firing this code from?


Reason to follow...
 
Good afternoon DCrake,

I assume you mean the name of my Database, it is named eFlowStatsFrontEnd.mdb. I am using MS Access 2000.

John
 
Code:
Function ExportToExcel()

DoCmd.Echo False, "Running Program" 
DoCmd.Hourglass True 
DoCmd.SetWarnings False 

Dim ExcelFile As String         
Dim ExcelWorksheet As String    
Dim FEDB As String              
Dim QueryName As String         
Dim objDB As Database           
Dim MyDate                      
Dim MyWeekDay                   

MyDate = Date 
MyWeekDay = Weekday(MyDate) 

If MyWeekDay = 6 Then

    ExcelFile = "G:\Biasi\WC" & "_" & Format(Date - 4, "ddmmyy") & ".xls" 
    ExcelWorksheet = "WC " & Format(Date - 4, "ddmmyy")                   
    FEDB = "H:\John Lee\eFlowStatsFrontEnd.mdb"                           
    QueryName = "qryExportToExceltblBiasi"                                

[COLOR="DarkRed"]    '/Why are you using OpenDataBase when CurrentDb is the current open database?[/COLOR]    
Set objDB = OpenDatabase(FEDB)  
    If Dir(ExcelFile) <> "" Then Kill ExcelFile 

    objDB.Execute "Select*Into[Excel 8.0;Database=" & ExcelFile & "].[" & ExcelWorksheet & "] From " & "[" & QueryName & "]"
    objDB.Close 
    Set objDB = Nothing 

    DoCmd.OpenQuery "qryApptblBiasiProcessHistoryToLongTerm", acNormal, acEdit

    DoCmd.OpenQuery "qryDeltblBiasiProcessHistory", acNormal, acEdit

End If
[COLOR="darkred"]'/If the day is not a Friday it still does all the following actions[/COLOR]

'/Would it not be better to say

[COLOR="darkred"]If MyWeekDay <> 6 Then
  Exit Function
End If[/COLOR]
Dim ObjExcel 
Set ObjExcel = CreateObject("Excel.Application") 
ObjExcel.Visible = True 
ObjExcel.Workbooks.Open "G:\Biasi\WC" & "_" & Format(Date - 4, "ddmmyy") & ".xls"
Set Objsheet = ObjExcel.ActiveWorkbook.Worksheets(1)


[COLOR="darkred"]'/At this point I would have done the following

Dim Rs As DAO.Recordset
Set Rs = CurrentDb.OpenRecordset( "qryExportToExceltblBiasi")[/COLOR]      
With Objsheet
    .Rows("1:1").Font.Bold = True
    .Columns("A:Z").Select
    .Columns("A:Z").EntireColumn.AutoFit
    [COLOR="darkred"].Range("A1").CopyFromRecordset Rs[/COLOR]
End With
[COLOR="darkred"]Rs.Close
Set Rs = nothing[/COLOR]
ObjExcel.ActiveWorkbook.Save 
ObjExcel.ActiveWorkbook.Close 
ObjExcel.Quit 

DoCmd.Echo True, "Program End" 
DoCmd.Hourglass False 
DoCmd.SetWarnings True 
End Function
 
Good Day DCrake,

Thanks for your response, but I don't understand your question

""'/Why are you using OpenDataBase when CurrentDb is the current open database?""

The code I am using is taken from code that I found elsewhere in this forum. because it worked when I tested it, I have used it.

" '/If the day is not a Friday it still does all the following actions"

In my testing I didn't experience that happening. so for instance because today is Wednesday, if I run the code no excel spreadsheet is created, so based on that the code is working as expected, although I take your point with regards to your suggested code for this section:

"If MyWeekDay <> 6 Then
Exit Function
End If
"

I will test this as I have done with the current code section.

I don't understand what your suggesting with regards to your suggested code:

"'/At this point I would have done the following

Dim Rs As DAO.Recordset
Set Rs = CurrentDb.OpenRecordset( "qryExportToExceltblBiasi")
"

".Range("A1").CopyFromRecordset Rs"

"Rs.Close
Set Rs = nothing
"

I don't understand why I need to create a record set, because the code I have currently does what I wanted. Is there something that I am missing in my understanding.

Your assistance is appreciated.

John
 
Hi DCrake,

I've reviewed my code following your observations, and it now looks like as shown below. I have tested the code by changing it to look for a Wednesday [4] and it works as expected. I've moved code to fall within the If/End If line of code so that the creation of the spreadsheet will only occur if the criteria is met for a Friday.

When I removed the opendatabase code section that you raised an observation on, I got error messages, on putting that line of code back in, the code ran as required. without fully understanding your observation regarding that line of code, and because the code is working as required, I have left that as it is.

Your assistance has been most appreciated.
Code:
[FONT=Times New Roman]Function ExportToExcel()[/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]DoCmd.Echo False, "Running Program"                                         [/FONT]
[FONT=Times New Roman]DoCmd.Hourglass True                                                        [/FONT]
[FONT=Times New Roman]DoCmd.SetWarnings False                                                     [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]Dim ExcelFile As String                                                     [/FONT]
[FONT=Times New Roman]Dim ExcelWorksheet As String                                                [/FONT]
[FONT=Times New Roman]Dim FEDB As String                                                          [/FONT]
[FONT=Times New Roman]Dim QueryName As String                                                     [/FONT]
[FONT=Times New Roman]Dim objDB As Database                                                       [/FONT]
[FONT=Times New Roman]Dim MyDate                                                                  [/FONT]
[FONT=Times New Roman]Dim MyWeekDay                                                               [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]MyDate = Date                                                               [/FONT]
[FONT=Times New Roman]MyWeekDay = Weekday(MyDate)                                                 [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]If MyWeekDay = 6 Then                                                       [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    ExcelFile = "G:\Biasi\WC" & "_" & Format(Date - 4, "ddmmyy") & ".xls"   [/FONT]
[FONT=Times New Roman]    ExcelWorksheet = "WC " & Format(Date - 4, "ddmmyy")                     [/FONT]
[FONT=Times New Roman]    FEDB = "G:\John LEE\eFlowStatsFrontEnd.mdb"                             [/FONT]
[FONT=Times New Roman]    QueryName = "qryExportToExceltblBiasi"                                  [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    [COLOR=red]Set objDB = OpenDatabase(FEDB)[/COLOR][COLOR=red]  [/COLOR]                                        [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    If Dir(ExcelFile) <> "" Then Kill ExcelFile                             [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    objDB.Execute "Select*Into[Excel 8.0;Database=" & ExcelFile & "].[" & ExcelWorksheet & "] From " & "[" & QueryName & "]"[/FONT]
[FONT=Times New Roman]    objDB.Close                                                             [/FONT]
[FONT=Times New Roman]    Set objDB = Nothing                                                     [/FONT]
[FONT=Times New Roman]    [/FONT]
[FONT=Times New Roman]    DoCmd.OpenQuery "qryApptblBiasiProcessHistoryToLongTerm", acNormal, acEdit[/FONT]
[FONT=Times New Roman]    DoCmd.OpenQuery "qryDeltblBiasiProcessHistory", acNormal, acEdit        [/FONT]
[FONT=Times New Roman]    [/FONT]
[FONT=Times New Roman]    Dim ObjExcel                                                            [/FONT]
[FONT=Times New Roman]    Set ObjExcel = CreateObject("Excel.Application")                        [/FONT]
[FONT=Times New Roman]    ObjExcel.Visible = True                                                 [/FONT]
[FONT=Times New Roman]    'Open the Excel workbook Biasi with the current week commencing date[/FONT]
[FONT=Times New Roman]    ObjExcel.Workbooks.Open "G:\Biasi\WC" & "_" & Format(Date - 4, "ddmmyy") & ".xls"[/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    Set Objsheet = ObjExcel.ActiveWorkbook.Worksheets(1)                    [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    With Objsheet                                                           [/FONT]
[FONT=Times New Roman]        .Rows("1:1").Font.Bold = True                                       [/FONT]
[FONT=Times New Roman]        .Rows("1:1").Font.Underline = xlUnderlineStyleSingle                [/FONT]
[FONT=Times New Roman]        .Columns("A:Z").Select                                              [/FONT]
[FONT=Times New Roman]        .Columns("A:Z").EntireColumn.AutoFit                                [/FONT]
[FONT=Times New Roman]    End With[/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    ObjExcel.ActiveWorkbook.Save                                            [/FONT]
[FONT=Times New Roman]    ObjExcel.ActiveWorkbook.Close                                           [/FONT]
[FONT=Times New Roman]    ObjExcel.Quit                                                           [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]End If[/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]DoCmd.Echo True, "Program End"                                              [/FONT]
[FONT=Times New Roman]DoCmd.Hourglass False                                                       [/FONT]
[FONT=Times New Roman]DoCmd.SetWarnings True                                                      [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]End Function[/FONT]

Thanks once again

John
 
John
Just to expand on my thoughts

When you open a database it becomes the CurrentDb
If you want to open another mdb other than the one you are currently in then you can use

FEDB = "G:\John LEE\eFlowStatsFrontEnd.mdb"
Set objDB = OpenDatabase(FEDB)


What you are essentially doing is opening a second instance of the mdb.

This is not to say it deos not work, as you have proved this.

Also the normally adopted method for copying tables/queries to Excel is to use the CopyFromRecordset method. Whereby you open an instance of Excel then open a workbook and go to a specific worksheet and make that the active worksheet.

Now lets say you already have a preformatted workbook and you want to add records to it. you would do the following


Code Snippet
Code:
Public Function ExportIE2Excel(DestPath As String)
On Error Resume Next
Dim ssql As String
    
'Export the query and open Excel
   'Start a new session in Excel
   'If default template exists use that
    If Dir(CurrentProject.Path & "\TemplateAllOutput.xlsx") <> "" Then
        '/ If an earlier version exists then delete it first
        If Dir(DestPath & TargetFile) <> "" Then
            Kill DestPath & TargetFile
            DoEvents
        
        End If
        FileCopy CurrentProject.Path & "\TemplateAllOutput.xlsx", DestPath & TargetFile
        
        'This uses late binding method
        Set xlapp = CreateObject("Excel.Application")
        Set xlbook = xlapp.Workbooks.Open(DestPath & TargetFile)
        Set xlsheet = xlbook.Worksheets(1)
            '/Corporate
            Dim Rs As DAO.Recordset
            
                   
            Set Rs = CurrentDb.OpenRecordset("QryIEDataGrp1")
            xlsheet.range("B13").CopyFromRecordset Rs
            
            Set Rs = CurrentDb.OpenRecordset("QryIEDataGrp2")
            xlsheet.range("X13").CopyFromRecordset Rs
           
            
            Rs.Close
            Set Rs = Nothing
            
            xlsheet.Columns("A:AL").EntireColumn.AutoFit
            xlsheet.range("C3:AL69").NumberFormat = "£#,##0.00"
            
            For x = 65 To 13 Step -1
               If xlsheet.range("B" & x).Value = "" Then
                  xlsheet.range("B" & x).EntireRow.Delete
              End If
            Next
            
            xlbook.Save
            xlapp.Quit
    
    End If

End Function
 

Users who are viewing this thread

Back
Top Bottom