AThom10731
IS-IT--Management
An error is received when I run the following code if I do not exit MS Access after running it. The code runs a query, exports results to an Excel file and formats the worksheets. If I exit Access each time it runs fine. I have a command button on a form that executes the code.
Any thoughts? Thanks for your assistance.
-----------------------------------------------------------------
Private Sub Command1_Click()
'Created a new Form called frm_CAPSummaryForm1
'Set it's RecoredSource to:
'SELECT [F_Site] FROM SEC_FindingRecords GROUP BY [F_Site];
'Add the field [F_Site] to the Detail section.
'Add a Command Button (Command1) to the form with the following code:
'
'If C:\ALL_CAPSpreadsheet.xls exists then delete it
If Dir("C:\ALL_CAPSpreadsheet.xls") <> "" Then
' the file exists, returns "" (empty string) if the file doesn't exist.
' Delete a file :
On Error GoTo ErrorHandler
Kill "C:\ALL_CAPSpreadsheet.xls"
End If
Me.Recordset.MoveFirst
Do
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QRY_CAP_SummaryAllDisc", "C:\ALL_CAPSpreadsheet.xls", True, Me.F_Site
Me.Recordset.MoveNext
Loop Until Me.Recordset.EOF
Call format_AllDiscworksheets
Exit Sub
ErrorHandler:
MsgBox "Sorry, another process is using ALL_CAPSpreadsheet.xls. Please log off or kill the excel process from Task Manager."
Exit Sub
End Sub
Function format_AllDiscworksheets()
Dim filePath As String
Dim TabFlag As String
Dim EX1 As Excel.Application
Dim EX1Book As Excel.Workbook
Dim EX1Sheet As Excel.Worksheet
Dim StatusColor As Integer
Dim StatusIndex As Integer
filePath = "C:\ALL_CAPSpreadsheet.xls"
Set EX1 = CreateObject("Excel.Application")
On Error GoTo ErrorHandling
Set EX1Book = EX1.Workbooks.Open(filePath)
MsgBox (" Formatting spreadsheet: " & filePath & "... Please wait on the hour glass to disappear before exiting. ")
EX1.Visible = False
For Each EX1Sheet In ActiveWorkbook.Worksheets
'place code between the For and Next
'for what you would like to do to
'each sheet
'All headers bold and centered with silver fill
EX1Sheet.Range("A1:O1").Font.Bold = True
EX1Sheet.Range("A1:O1").HorizontalAlignment = Excel.xlLeft
EX1Sheet.Range("A1:O1").Interior.Color = RGB(192, 192, 192)
EX1Sheet.Range("A1:O200").Font.Size = 9
'All other data is wrap text and top left
EX1Sheet.Range("A2:O200").HorizontalAlignment = xlLeft
EX1Sheet.Range("A2:O200").VerticalAlignment = xlTop
EX1Sheet.Range("A2:O200").WrapText = True
EX1Sheet.Range("A2:O200").Orientation = 0
EX1Sheet.Range("A2:O200").AddIndent = False
EX1Sheet.Range("A2:O200").ShrinkToFit = False
EX1Sheet.Range("A2:O200").ReadingOrder = xlContext
EX1Sheet.Range("A2:O200").MergeCells = False
EX1Sheet.Columns("E:G").ColumnWidth = 25
EX1Sheet.Columns("A:B").ColumnWidth = 17
EX1Sheet.Columns("D").ColumnWidth = 17
EX1Sheet.Columns("H").ColumnWidth = 17
EX1Sheet.Columns("I:K").ColumnWidth = 11
EX1Sheet.Columns("L:M").ColumnWidth = 14
EX1Sheet.Columns("N").ColumnWidth = 25
EX1Sheet.Columns("B:O").AutoFilter
'center C, I, J, K, O
EX1Sheet.Columns("C").HorizontalAlignment = Excel.xlCenter
EX1Sheet.Columns("I:K").HorizontalAlignment = Excel.xlCenter
EX1Sheet.Columns("O").HorizontalAlignment = Excel.xlCenter
'Conditionally Format Status by filling the cell with the applicable status color
For StatusIndex = 2 To 200
'Status needs to be green if a finish date is present
If IsDate(EX1Sheet.Range("K" & StatusIndex).Value) Then
EX1Sheet.Range("L" & StatusIndex).Interior.Color = RGB(50, 205, 50)
EX1Sheet.Range("L" & StatusIndex).Value = "Green"
Else
Select Case EX1Sheet.Range("L" & StatusIndex).Value
Case "Green"
EX1Sheet.Range("L" & StatusIndex).Interior.Color = RGB(50, 205, 50)
Case "Yellow"
EX1Sheet.Range("L" & StatusIndex).Interior.Color = RGB(255, 255, 0)
Case "Red"
EX1Sheet.Range("L" & StatusIndex).Interior.Color = RGB(255, 0, 0)
End Select
End If
Next StatusIndex
For StatusIndex = 2 To 200
'SI_DatabaseRating needs to dumped with no changes but background
Select Case EX1Sheet.Range("M" & StatusIndex).Value
Case "Green"
EX1Sheet.Range("M" & StatusIndex).Interior.Color = RGB(50, 205, 50)
Case "Yellow"
EX1Sheet.Range("M" & StatusIndex).Interior.Color = RGB(255, 255, 0)
Case "Red"
EX1Sheet.Range("M" & StatusIndex).Interior.Color = RGB(255, 0, 0)
End Select
Next StatusIndex
TabFlag = "Green"
EX1Sheet.Tab.ColorIndex = 10
For StatusIndex = 2 To 200
'Tab color needs to be red if at least one Red in column L
'If no reds found then if a yellow is found then the value is yellow
'If no reds are found and no yellows are found then the value of the tab stays green
Select Case EX1Sheet.Range("L" & StatusIndex).Value
Case "Red"
TabFlag = "Red"
EX1Sheet.Tab.ColorIndex = 3
Case "Yellow"
If TabFlag <> "Red" Then
TabFlag = "Yellow"
EX1Sheet.Tab.ColorIndex = 6
End If
End Select
Next StatusIndex
Next
EX1.DisplayAlerts = False
'X1Book.Save
'X1Book.SaveAs (filePath & Format(Date, "mmdd") & ".xls")
filePath = "C:\ALL_CAPSpreadsheet" & Format(Now, "yyyymmdd_hhmmss") & ".xls"
MsgBox "Your output file is:: " & filePath & "... Exit the database before opening Excel"
EX1Book.Save
EX1Book.SaveAs filePath
EX1Book.Close True
Set EX1Sheet = Nothing
Set EX1Book = Nothing
'Excel.Application.Quit
EX1.Quit
Set EX1 = Nothing
On Error GoTo ErrorHandling
Kill "C:\ALL_CAPSpreadsheet.xls"
Exit Function
ErrorHandling:
MsgBox "Sorry, another process is using ALL_CAPSpreadsheet.xls. Please log off or kill the excel process from Task Manager."
Exit Function
End Function
Any thoughts? Thanks for your assistance.
-----------------------------------------------------------------
Private Sub Command1_Click()
'Created a new Form called frm_CAPSummaryForm1
'Set it's RecoredSource to:
'SELECT [F_Site] FROM SEC_FindingRecords GROUP BY [F_Site];
'Add the field [F_Site] to the Detail section.
'Add a Command Button (Command1) to the form with the following code:
'
'If C:\ALL_CAPSpreadsheet.xls exists then delete it
If Dir("C:\ALL_CAPSpreadsheet.xls") <> "" Then
' the file exists, returns "" (empty string) if the file doesn't exist.
' Delete a file :
On Error GoTo ErrorHandler
Kill "C:\ALL_CAPSpreadsheet.xls"
End If
Me.Recordset.MoveFirst
Do
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QRY_CAP_SummaryAllDisc", "C:\ALL_CAPSpreadsheet.xls", True, Me.F_Site
Me.Recordset.MoveNext
Loop Until Me.Recordset.EOF
Call format_AllDiscworksheets
Exit Sub
ErrorHandler:
MsgBox "Sorry, another process is using ALL_CAPSpreadsheet.xls. Please log off or kill the excel process from Task Manager."
Exit Sub
End Sub
Function format_AllDiscworksheets()
Dim filePath As String
Dim TabFlag As String
Dim EX1 As Excel.Application
Dim EX1Book As Excel.Workbook
Dim EX1Sheet As Excel.Worksheet
Dim StatusColor As Integer
Dim StatusIndex As Integer
filePath = "C:\ALL_CAPSpreadsheet.xls"
Set EX1 = CreateObject("Excel.Application")
On Error GoTo ErrorHandling
Set EX1Book = EX1.Workbooks.Open(filePath)
MsgBox (" Formatting spreadsheet: " & filePath & "... Please wait on the hour glass to disappear before exiting. ")
EX1.Visible = False
For Each EX1Sheet In ActiveWorkbook.Worksheets
'place code between the For and Next
'for what you would like to do to
'each sheet
'All headers bold and centered with silver fill
EX1Sheet.Range("A1:O1").Font.Bold = True
EX1Sheet.Range("A1:O1").HorizontalAlignment = Excel.xlLeft
EX1Sheet.Range("A1:O1").Interior.Color = RGB(192, 192, 192)
EX1Sheet.Range("A1:O200").Font.Size = 9
'All other data is wrap text and top left
EX1Sheet.Range("A2:O200").HorizontalAlignment = xlLeft
EX1Sheet.Range("A2:O200").VerticalAlignment = xlTop
EX1Sheet.Range("A2:O200").WrapText = True
EX1Sheet.Range("A2:O200").Orientation = 0
EX1Sheet.Range("A2:O200").AddIndent = False
EX1Sheet.Range("A2:O200").ShrinkToFit = False
EX1Sheet.Range("A2:O200").ReadingOrder = xlContext
EX1Sheet.Range("A2:O200").MergeCells = False
EX1Sheet.Columns("E:G").ColumnWidth = 25
EX1Sheet.Columns("A:B").ColumnWidth = 17
EX1Sheet.Columns("D").ColumnWidth = 17
EX1Sheet.Columns("H").ColumnWidth = 17
EX1Sheet.Columns("I:K").ColumnWidth = 11
EX1Sheet.Columns("L:M").ColumnWidth = 14
EX1Sheet.Columns("N").ColumnWidth = 25
EX1Sheet.Columns("B:O").AutoFilter
'center C, I, J, K, O
EX1Sheet.Columns("C").HorizontalAlignment = Excel.xlCenter
EX1Sheet.Columns("I:K").HorizontalAlignment = Excel.xlCenter
EX1Sheet.Columns("O").HorizontalAlignment = Excel.xlCenter
'Conditionally Format Status by filling the cell with the applicable status color
For StatusIndex = 2 To 200
'Status needs to be green if a finish date is present
If IsDate(EX1Sheet.Range("K" & StatusIndex).Value) Then
EX1Sheet.Range("L" & StatusIndex).Interior.Color = RGB(50, 205, 50)
EX1Sheet.Range("L" & StatusIndex).Value = "Green"
Else
Select Case EX1Sheet.Range("L" & StatusIndex).Value
Case "Green"
EX1Sheet.Range("L" & StatusIndex).Interior.Color = RGB(50, 205, 50)
Case "Yellow"
EX1Sheet.Range("L" & StatusIndex).Interior.Color = RGB(255, 255, 0)
Case "Red"
EX1Sheet.Range("L" & StatusIndex).Interior.Color = RGB(255, 0, 0)
End Select
End If
Next StatusIndex
For StatusIndex = 2 To 200
'SI_DatabaseRating needs to dumped with no changes but background
Select Case EX1Sheet.Range("M" & StatusIndex).Value
Case "Green"
EX1Sheet.Range("M" & StatusIndex).Interior.Color = RGB(50, 205, 50)
Case "Yellow"
EX1Sheet.Range("M" & StatusIndex).Interior.Color = RGB(255, 255, 0)
Case "Red"
EX1Sheet.Range("M" & StatusIndex).Interior.Color = RGB(255, 0, 0)
End Select
Next StatusIndex
TabFlag = "Green"
EX1Sheet.Tab.ColorIndex = 10
For StatusIndex = 2 To 200
'Tab color needs to be red if at least one Red in column L
'If no reds found then if a yellow is found then the value is yellow
'If no reds are found and no yellows are found then the value of the tab stays green
Select Case EX1Sheet.Range("L" & StatusIndex).Value
Case "Red"
TabFlag = "Red"
EX1Sheet.Tab.ColorIndex = 3
Case "Yellow"
If TabFlag <> "Red" Then
TabFlag = "Yellow"
EX1Sheet.Tab.ColorIndex = 6
End If
End Select
Next StatusIndex
Next
EX1.DisplayAlerts = False
'X1Book.Save
'X1Book.SaveAs (filePath & Format(Date, "mmdd") & ".xls")
filePath = "C:\ALL_CAPSpreadsheet" & Format(Now, "yyyymmdd_hhmmss") & ".xls"
MsgBox "Your output file is:: " & filePath & "... Exit the database before opening Excel"
EX1Book.Save
EX1Book.SaveAs filePath
EX1Book.Close True
Set EX1Sheet = Nothing
Set EX1Book = Nothing
'Excel.Application.Quit
EX1.Quit
Set EX1 = Nothing
On Error GoTo ErrorHandling
Kill "C:\ALL_CAPSpreadsheet.xls"
Exit Function
ErrorHandling:
MsgBox "Sorry, another process is using ALL_CAPSpreadsheet.xls. Please log off or kill the excel process from Task Manager."
Exit Function
End Function