Hello again,
I have this database that has been mentioned a few times to keep track of electrical parts auditing and testing.
There has been much help here on the export to excel feature I needed added to send weekly reports to testers to show them. The export works great and does exactly what I was looking for.... however
I just discovered today that if there are no records in my database with a status of "Waiting on Lab Testing", the database appears to lock up and I have to get my desktop to show again to see the error prompt that pops up which I have attached a screenshot of.
Is there any way to put in code to make a popup tell me there are no records to export or something like that? I am afraid to tinker with this code... I don't want to break it.
Here is the module:
Here is the button code:
I have this database that has been mentioned a few times to keep track of electrical parts auditing and testing.
There has been much help here on the export to excel feature I needed added to send weekly reports to testers to show them. The export works great and does exactly what I was looking for.... however
I just discovered today that if there are no records in my database with a status of "Waiting on Lab Testing", the database appears to lock up and I have to get my desktop to show again to see the error prompt that pops up which I have attached a screenshot of.
Is there any way to put in code to make a popup tell me there are no records to export or something like that? I am afraid to tinker with this code... I don't want to break it.
Here is the module:
Code:
Public Function fnLastRow(sh As Object)
On Error Resume Next
With sh
fnLastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=2, _
LookIn:=5, _
SearchOrder:=1, _
SearchDirection:=2, _
MatchCase:=False).Row
End With
End Function
Here is the button code:
Code:
Private Sub Command35_Click()
Const FileNameBase As String = "\Weekly Reports\Waiting on Lab Weekly Report [CurrentDate].xlsx"
Dim strFileName As String
strFileName = Replace(FileNameBase, "[CurrentDate]", Format$(Date, "m-dd-yyyy"))
If DCount("*", "qry_advancewaitlab") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_advancewaitlab", strFileName, True, "Advance"
End If
If DCount("*", "qry_arcadiawaitlab") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_arcadiawaitlab", strFileName, True, "Arcadia"
End If
If DCount("*", "qry_ecruwaitlab") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_ecruwaitlab", strFileName, True, "Ecru"
End If
If DCount("*", "qry_leesportwaitlab") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_leesportwaitlab", strFileName, True, "Leesport"
End If
If DCount("*", "qry_wanekwaitlab") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_wanekwaitlab", strFileName, True, "Wanek"
End If
If DCount("*", "qry_wanvogwaitlab") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_wanvogwaitlab", strFileName, True, "Wanvog"
End If
Dim xlWB As Object
Dim xlObj As Object
Dim xlSheet As Object
Dim lngRow As Long
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:H1").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 = 15
.Columns("H:H").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 Sub