Coloring Excel cells on export

[Garrett!]

Hi. I am trying to export two queries from Access 2007 into Excel. I would like the queries to be on separate sheets within the workbook. I have this working the way I would like. In both queries I have a Boolean field. If the Boolean is Yes than I would like to highlight the Excel row red. Is this possible? The code I have for the export is:

Dim strExcelFile As String
Dim strWorksheetActive As String
Dim strWorksheetCancel As String
Dim strDB As String
Dim strTableActive As String
Dim strTableCancel As String
Dim objDB As Database
Dim strUser As String
Dim ApXl As Object

Set ApXl = CreateObject("Excel.Application")
strUser = fOSUserName()


'Change Based on your needs, or use
'as parameters to the sub
strExcelFile = "U:\" & strUser & "\DealerContacts.xls"
strWorksheetActive = "ActiveDealers"
strWorksheetCancel = "CanceledDealers"
strDB = "U:\Contacts DB"
strTableActive = "qryExcelExportActive"
strTableCancel = "qryExcelExportCancel"



Set objDB = CurrentDb

 'If excel file already exists, you can delete it here
 If Dir(strExcelFile) <> "" Then Kill strExcelFile

objDB.Execute _
  "SELECT * INTO [Excel 8.0;DATABASE=" & strExcelFile & _
   "].[" & strWorksheetActive & "] FROM " & "[" & strTableActive & "]"
     
objDB.Execute _
  "SELECT * INTO [Excel 8.0;DATABASE=" & strExcelFile & _
   "].[" & strWorksheetCancel & "] FROM " & "[" & strTableCancel & "]"
   
   MsgBox "Thank you.  The files has been saved on the U drive under U:\DealerContacts", vbInformation, "Export Saved"
   
objDB.Close
Set objDB = Nothing

End Sub

Many thanks.

 

[Pyro]

There are several options. Here are a couple.

1. Rather than create a new Excel workbook each time, you could store a pre-formatted template that you export your data to. The template would already have conditional formatting on the column that stores your boolean value.

2. Once your current code completes, you could have Access open the file and iterate through the data, performing formatting as required. Something like the below (copied and pasted, then trimmed) not tested!

Public Function Excel_Format(strFile_Path As String)
On Error GoTo Err_Excel_Format

Dim obExcel As Object
Dim intStart As Integer
Dim strCell As String
Dim strFolder As String
Dim strPhoto_Path As String
Dim strCell_Value As String

'Open excel
Set obExcel = CreateObject("Excel.Application")

With obExcel
    .WorkBooks.Open strFile_Path, True, False
        
    'Select first sheet**********************************************************************
    .Sheets(1).select

    'Loop through the required column
    'Set starting row (assume first row has column headers)
    intStart = 2

    Do
        strCell = "B" & intStart
        
        With .Range(strCell)
            If .cells(1).Value = "Yes" Then
                .EntireRow.Interior.Color = RGB(255, 0, 0)

            End If

        End With
        
        intStart = intStart + 1
        
    Loop Until strCell = "B" & .cells(.Rows.Count, "B").End(3).Row
    
    .ActiveWorkbook.Save
    .Application.Quit
        
End With

Exit_Excel_Format:
    Set obExcel = Nothing

    Exit Function

Err_Excel_Format:
    MsgBox Err.Description
    Resume Exit_Excel_Format
    
End Function

 

[Garrett!]

Awesome! Would you like to be my new hero? This worked perfectly. In case anyone else ever needs this, I went with option #2 and used the code you supplied. I did change the line of code to: strCell = "Q" & intStart because "Q" was were my Boolean field was. Thank you!