Export to Excel not working after SetAccessWindow code (1 Viewer)

psyc0tic1

Access Moron
Local time
Today, 08:08
Joined
Jul 10, 2017
Messages
360
In another thread I was asking about issues with my reports opening minimized due tot he setaccesswindow code. I was able to get around that with some properties settings for the reports...

However I just realized this morning that my export to excel no longer works.

There are three modules.
#1 exports data to an excel spreadsheet with a certain criteria
#2 exports data to an excel spreadsheet with a different criteria
#3 creates the email attaching the spreadsheets and displays it for me to review before sending.

#1 and #2 do not function but #3 does. I know that sounds strange but if there are already excel files in the folder where module #3 looks it will generate the email but if #1 and #2 do not function (like now) then I get a message box telling me there are no files to send.

Any idea why this code no longer works?

Here is the code to call the code in the modules from frm_home (in red):
Code:
Private Sub Form_Open(Cancel As Integer)

    If Credentials.AccessLvlID = 0 Then
        DoCmd.OpenForm "frm_loginform"
        Cancel = 1
    End If
    
 [COLOR="Red"]   If Credentials.AccessLvlID = 1 Then
        If Weekday(Now) = vbMonday Then
            WaitVis
            WaitLab
            SendEMail
        End If
    End If[/COLOR]
   
        FEVersion = DLookup("fe_version_number", "tbl-fe_version")
        DoCmd.SetWarnings False
        DoCmd.RunSQL "UPDATE tbl_users SET Version = '" & FEVersion & "' WHERE ID = " & Credentials.UserId
    
    If Credentials.AccessLvlID = 6 Then
        MsgBox "Your Account Has Been Deactivated. Please Contact the Administrator."
        DoCmd.Quit
        End If
End Sub

The WaitVis and WaitLab are not firing but SendEmail does.

The version checker code under it still works too.

Here is the module for WaitVis (named mod_WV):
Code:
Option Compare Database

Public Function WaitVis()
    On Error Resume Next

    Const FileNameBase As String = "\\ashleyfurniture.com\afi-dfs\ecru\dept\Quality-Projects\RCabler\Databases\Weekly Reports\Waiting on Visual Weekly Report [CurrentDate].xlsx"
        Dim strFileName As String
        strFileName = Replace(FileNameBase, "[CurrentDate]", Format$(Date, "m-dd-yyyy"))
    
    If DCount("*", "qry_advancewaitvis") > 0 Then
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_advancewaitvis", strFileName, True, "Advance"
    End If
    If DCount("*", "qry_arcadiawaitvis") > 0 Then
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_arcadiawaitvis", strFileName, True, "Arcadia"
    End If
    If DCount("*", "qry_ecruwaitvis") > 0 Then
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_ecruwaitvis", strFileName, True, "Ecru"
    End If
    If DCount("*", "qry_leesportwaitvis") > 0 Then
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_leesportwaitvis", strFileName, True, "Leesport"
    End If
    If DCount("*", "qry_ripleywaitvis") > 0 Then
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_ripleywaitvis", strFileName, True, "Ripley"
    End If
    If DCount("*", "qry_wanekwaitvis") > 0 Then
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_wanekwaitvis", strFileName, True, "Wanek"
    End If
    If DCount("*", "qry_whitehallwaitvis") > 0 Then
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_whitehallwaitvis", strFileName, True, "Whitehall"
    End If
    
    Dim xlWB As Object
    Dim xlObj As Object
    Dim xlSheet As Object
    Dim lngRow As Long
    
    If Len(Dir(strFileName)) > 0 Then
        Set xlObj = CreateObject("Excel.Application")
        Set xlWB = xlObj.Workbooks.Open(strFileName, False, False)
        
        For Each xlSheet In xlWB.Worksheets
            
            With xlSheet
                
                .Activate
                lngRow = .Cells(.Rows.Count, 1).End(-4162).Row 'xlUp
                Debug.Print lngRow
                .Range("F1:F" & lngRow).Select
                xlObj.Selection.FormatConditions.Add Type:=2, Formula1:= _
                        "=TODAY()-F1>13"
                xlObj.Selection.FormatConditions(xlObj.Selection.FormatConditions.Count).SetFirstPriority
                With xlObj.Selection.FormatConditions(1).Interior
                    .PatternColorIndex = -4105
                    .Color = 255
                    .TintAndShade = 0
                End With
                xlObj.Selection.FormatConditions(1).StopIfTrue = False
                .Range("A1:G1").Select
                With xlObj.Selection
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ReadingOrder = xlContext
                    .MergeCells = False
                    
                    With .Font
                        .Name = "Calibri"
                        .FontStyle = "Bold"
                        .Size = 11
                    End With
                    .Borders(xlDiagonalDown).LineStyle = xlNone
                    .Borders(xlDiagonalUp).LineStyle = xlNone
                    With .Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With .Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With .Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With .Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With .Borders(xlInsideVertical)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    .Borders(xlInsideHorizontal).LineStyle = xlNone
                    With .Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .ThemeColor = xlThemeColorDark1
                        .TintAndShade = -0.14996795556505
                        .PatternTintAndShade = 0
                    End With
                End With
                .Columns("A:A").Select
                xlObj.Selection.ColumnWidth = 8.3
                .Columns("B:B").Select
                xlObj.Selection.ColumnWidth = 28.86
                .Columns("C:C").Select
                xlObj.Selection.ColumnWidth = 13.29
                .Columns("D:D").Select
                xlObj.Selection.ColumnWidth = 12.57
                .Columns("E:E").Select
                xlObj.Selection.ColumnWidth = 13.57
                .Columns("F:F").Select
                xlObj.Selection.ColumnWidth = 11
                .Columns("G:G").Select
                xlObj.Selection.ColumnWidth = 13.29
                .Range("A1").Select
                xlObj.ActiveWindow.FreezePanes = False
    
                            
            End With
    
        Next
        xlObj.Sheets(1).Activate
        xlWB.Close True
        Set xlSheet = Nothing
        Set xlWB = Nothing
        xlObj.Quit
        Set xlObj = Nothing
    End If
End Function

Does the access application window need to be open (not minimized) for this to work?
 

isladogs

MVP / VIP
Local time
Today, 13:08
Joined
Jan 14, 2017
Messages
18,186
No idea but the obvious thing is to temporarily disable the code to hide the application interface and see if the Excel code then works again.
 
Last edited:

psyc0tic1

Access Moron
Local time
Today, 08:08
Joined
Jul 10, 2017
Messages
360
No idea but the obvious thing is to temporarily disable the code to hide the application interface and see if the Excel code then works again.

Yea... I was just trying that and after commenting it out the export still didn't work.

I went a step further and commented out the code for the tab change that was worked on in the other thread and the export still doesn't work anymore.

I wonder what happened.

Gonna take some more digging I guess.

Looks like I will be starting all over again and checking features one at a time after each modification.
 

psyc0tic1

Access Moron
Local time
Today, 08:08
Joined
Jul 10, 2017
Messages
360
Very strange... I started over and copied all queries, forms, reports from the one that was not working into the new one and everything works.

Makes no sense.

One downfall though... it is back to opening slowly again. Whatever is different (which there can't be) is making it slow again.

I suppose this thread can be deleted as it serves no purpose now.
 

isladogs

MVP / VIP
Local time
Today, 13:08
Joined
Jan 14, 2017
Messages
18,186
No don't delete it. The thread may be useful to others.

It sounds like you may have some corrupted code.

Try and improve performance as follows
1. Decompile your database. This removes any corrupt compilation code
2. Check you have Require Variable Declaration ticked in the VBE Options and Option Explicit at the top of all modules.
3. Run Debug....Compile and fix all errors that arise
4. Compact.
 

Users who are viewing this thread

Top Bottom