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):
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):
Does the access application window need to be open (not minimized) for this to work?
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?