Solved Formatting Excel File from Access (1 Viewer)

[Drand]

Hi all

I am trying to run code that formats an excel spreadsheet after it is created in Access.

My code is:

Private Sub cmdExportMissingDataFiles_Click()
On Error GoTo ErrorHandler

    Dim rs As Recordset: Set rs = CurrentDb.OpenRecordset("SELECT DISTINCT CountryCode, Country FROM qryMissingData")
    Dim CreationMoment As String: CreationMoment = " Created on " & Format(Date, "ddmmyy") & " at " & Format(Time, "hhmmss")
    Dim strSql As String
    Dim AndWhere As String
    Do While Not rs.EOF

        ' this is the right alias
        AndWhere = "tblConsolRawData.CountryCode = " & rs!CountryCode
        ' access the sql string in the querydef and replace the semicolon with the where clause
        strSql = Replace(CurrentDb.QueryDefs("QryMissingData").Sql, ";", " AND " & AndWhere)
        CurrentDb.CreateQueryDef "CountryFile", strSql
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "CountryFile", "C:\KPMG\Missing data Files\" & "Missing Data For Country Code  " & rs!CountryCode, True
        DoCmd.DeleteObject acQuery, "CountryFile"

        
Dim xlApp As Object     'Excel.Application
Dim xlWB As Object      'Excel.Workbook
Dim xlSh As Object      'Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")   'New Excel.Application
Set xlWB = xlApp.Workbooks.Open("C:\KPMG\Missing data Files\" & "Missing Data For Country Code  " & rs!CountryCode)
Set xlSh = xlWB.Sheets(1)

xlApp.Visible = True

 Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(A1))=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599963377788629
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    xlWB.Close True
    xlApp.Quit
    Set xlApp = Nothing
    rs.MoveNext


    Loop
ErrorHandler:
    If Err.Number <> 0 Then
        MsgBox Err.Number & vbCr & Err.Description
       ' make sure CountryFile is deleted anyway
        DoCmd.DeleteObject acQuery, "CountryFile"
    End If
    
    Call CountFiles
   rs.Close
    
  End Sub

When the first file in the loop is created, the formatting works perfectly. When it loops to the second file, the file is created, it opens but then I get an error message
"Run Time Error 1004 Method 'Range' of Object_'Global' failed.

This occurs at Range("A1").Select

Would aprreciate some assistance with this.

Thanks

 

[Eugene-LS]

Would aprreciate some assistance with this.

Please try this code:

Spoiler: Private Sub cmdExportMissingDataFiles_Click()

Private Sub cmdExportMissingDataFiles_Click()
Dim rs As Recordset
Dim CreationMoment As String: CreationMoment = " Created on " & Format(Date, "ddmmyy") & " at " & Format(Time, "hhmmss")
Dim strSql As String
Dim AndWhere As String

Dim xlApp As Object     'Excel.Application
Dim xlWB As Object      'Excel.Workbook
Dim xlSh As Object      'Excel.Worksheet
Dim sFilePath$

On Error GoTo ErrorHandler
    
    Set rs = CurrentDb.OpenRecordset("SELECT DISTINCT CountryCode, Country FROM qryMissingData")
    Set xlApp = CreateObject("Excel.Application")   'New Excel.Application
    
    Do While Not rs.EOF
        Debug.Print rs!CountryCode
        ' this is the right alias
        AndWhere = "tblConsolRawData.CountryCode = " & rs!CountryCode
        ' access the sql string in the querydef and replace the semicolon with the where clause
        strSql = Replace(CurrentDb.QueryDefs("QryMissingData").SQL, ";", " AND " & AndWhere)
        
        CurrentDb.CreateQueryDef "CountryFile", strSql
        
        sFilePath = "C:\KPMG\Missing data Files\" & "Missing Data For Country Code  " & rs!CountryCode
        
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "CountryFile", sFilePath, True
        DoCmd.DeleteObject acQuery, "CountryFile"

        Set xlWB = xlApp.Workbooks.Open(sFilePath)
        Set xlSh = xlWB.Sheets(1)
    
        xlApp.Visible = True
        xlSh.Range("A1").Select
        xlSh.Range(xlApp.Selection, xlApp.Selection.End(-4121)).Select   '-4121 = xlDown
        xlSh.Range(xlApp.Selection, xlApp.Selection.End(-4161)).Select   '-4161 = xlToRight
        xlApp.Selection.FormatConditions.Add 2, , "=LEN(TRIM(A1))=0"     '2 = xlExpression
        xlApp.Selection.FormatConditions(xlApp.Selection.FormatConditions.Count).SetFirstPriority
        With xlApp.Selection.FormatConditions(1).Interior
            .PatternColorIndex = -4105                                '-4105 = xlAutomatic
            .ThemeColor = 4                                           '4 = xlThemeColorLight2
            .TintAndShade = 0.599963377788629
        End With
        xlApp.Selection.FormatConditions(1).StopIfTrue = False
        
        xlWB.Close True
        rs.MoveNext
    Loop

    Call CountFiles
    
cmdExportMissingDataFiles_Bye:
    On Error Resume Next
    rs.Close: Set rs = Nothing
    Set xlWB = Nothing
    Set xlSh = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    Err.Clear
    Exit Sub

ErrorHandler:
    MsgBox Err.Number & vbCr & Err.Description
    ' make sure CountryFile is deleted anyway
    DoCmd.DeleteObject acQuery, "CountryFile"
    
    Resume cmdExportMissingDataFiles_Bye
  End Sub

 

[Drand]

Thanks for this. Really works well but one small thing. At the end of the process, it leaves Excel open on screen.

 

[Eugene-LS]

Really works well but one small thing. At the end of the process, it leaves Excel open on screen.

That's unexpected. It didn't happen to me.
Can you post a sample DB with test data?

 

[Drand]

That's not all that easy. It's really large.
However, when I changed xlApp.Visible = True to false which I wanted to do anyway, it fixed the issue.

Many thanks for your help.

 

[Eugene-LS]

That's not all that easy. It's really large

Make test application with just the form (with subforms) and required tables/queries.
Just a few (fictitious) records to view error.