Hi all,
I'm having difficulty with Excel automation. I get the Excel spreadsheets populated correctly (until the error), but when I run the subroutine it causes wacky problems within Windows 95. For instance, I see that a series of 0 KB length files (with no extension) are being created with names like 'A5980000' in the same directory where I store my Excel files. Then about halfway through the process, any open program I have running becomes locked and in the Close Program dialog box it has [Not Responding] next to it. If I click on the Excel process and then 'End Task', all my programs are ready to go again. It does not make it through the program without this happening. I'm wondering if any of you gurus could take the time to look at my code and see if there are major bugs. Otherwise I'm at a loss. Thanks very much!
I'm having difficulty with Excel automation. I get the Excel spreadsheets populated correctly (until the error), but when I run the subroutine it causes wacky problems within Windows 95. For instance, I see that a series of 0 KB length files (with no extension) are being created with names like 'A5980000' in the same directory where I store my Excel files. Then about halfway through the process, any open program I have running becomes locked and in the Close Program dialog box it has [Not Responding] next to it. If I click on the Excel process and then 'End Task', all my programs are ready to go again. It does not make it through the program without this happening. I'm wondering if any of you gurus could take the time to look at my code and see if there are major bugs. Otherwise I'm at a loss. Thanks very much!
Code:
Private Sub cmdEmailReports_Click()
DoCmd.SetWarnings False
Dim strPath As String
Dim strFile As String
Dim strTestFile As String 'to check if file exists
Dim rstSales As ADODB.Recordset 'for all Sales Ids with activity
Dim rstIndividual As ADODB.Recordset 'an individual Salesperson's data
Dim WeeklyDetail As Excel.Worksheet 'for PST detail report
Dim WeeklySummary As Excel.Worksheet 'for PST summary report
Dim WeeklyPSTwb As Excel.Workbook
Dim CurrRow As Integer 'counter for Excel row
Dim CurrCell As Integer 'counter for Excel cell
Dim f As Field 'to insert field names into Excel spreadsheet
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.Application")
Set rstSales = New ADODB.Recordset
Set rstIndividual = New ADODB.Recordset
strPath = "C:\data\temp\"
'Compile PST data
rstSales.Open "Select * from qselSalespeoplewithLoads", CurrentProject.Connection
Do Until rstSales.EOF
Me.cboSales = rstSales!SalesCode
'
' Compile Summary Data
'
rstIndividual.Open "Select * from tblSalesDataSummary WHERE [SalesCode] = " & Forms!frmMain.cboSales, CurrentProject.Connection
strFile = strPath & rstSales!SalesName & " PST Monthly Sales.xls"
'Check for existing file and delete if found
strTestFile = Dir(strFile)
If strPath & strTestFile = strFile Then
Kill (strFile)
End If
'Open new Excel Workbook
Set WeeklyPSTwb = Excel.Workbooks.Add
WeeklyPSTwb.SaveAs strFile
'Point to Sheet1
Set WeeklySummary = WeeklyPSTwb.Worksheets.Item("Sheet1")
WeeklySummary.Name = "Summary"
'Loop through the Weekly PST data for the current salesperson and add to Excel file
CurrRow = 1
CurrCell = 1
With WeeklySummary
For Each f In rstIndividual.Fields 'add field names
.Cells(CurrRow, CurrCell).Value = f.Name
CurrCell = CurrCell + 1
Next f
CurrRow = 2
CurrCell = 1
Do Until rstIndividual.EOF
For Each f In rstIndividual.Fields
If f.Name Like "*Rev*" Then
.Cells(CurrRow, CurrCell).NumberFormat = "$#,##0.00"
End If
If f.Name Like "*Cont*" Then
.Cells(CurrRow, CurrCell).NumberFormat = "$#,##0.00"
End If
If f.Name Like "*CM*" Then
.Cells(CurrRow, CurrCell).NumberFormat = "0.00%"
End If
.Cells(CurrRow, CurrCell).Value = f.Value 'add data
CurrCell = CurrCell + 1
Next f
CurrRow = CurrRow + 1
CurrCell = 1
rstIndividual.MoveNext 'move to next record for individual salesperson
Loop
End With
rstIndividual.Close 'close recordset
'
' Compile Detail Data
'
rstIndividual.Open "Select * from tblSalesDataDetail WHERE [SalesCode] = " & Forms!frmMain.cboSales, CurrentProject.Connection
strFile = strPath & rstSales!SalesName & " PST Monthly Sales.xls"
'Point to Sheet2
Set WeeklyDetail = WeeklyPSTwb.Worksheets.Item("Sheet2")
WeeklyDetail.Name = "Detail"
'Loop through the Weekly PST data for the current salesperson and add to Excel file
CurrRow = 1
CurrCell = 1
With WeeklyDetail
For Each f In rstIndividual.Fields
.Cells(CurrRow, CurrCell).Value = f.Name 'add field names
CurrCell = CurrCell + 1
Next f
CurrRow = 2
CurrCell = 1
Do Until rstIndividual.EOF
For Each f In rstIndividual.Fields
If f.Name Like "*Rev*" Then
.Cells(CurrRow, CurrCell).NumberFormat = "$#,##0.00"
End If
If f.Name Like "*Cont*" Then
.Cells(CurrRow, CurrCell).NumberFormat = "$#,##0.00"
End If
If f.Name Like "*CM*" Then
.Cells(CurrRow, CurrCell).NumberFormat = "0.00%"
End If
'.Cells(CurrRow, CurrCell).AutoSize
.Cells(CurrRow, CurrCell).Value = f.Value 'add data
CurrCell = CurrCell + 1
Next f
CurrRow = CurrRow + 1
CurrCell = 1
rstIndividual.MoveNext 'move to next record for individual salesperson
Loop
WeeklyPSTwb.Save 'save workbook
WeeklyPSTwb.Close 'close workbook
End With
rstSales.MoveNext 'move to next salesperson
rstIndividual.Close 'close recordset
Loop
rstSales.Close
xlApp.Quit 'quit Excel
'Cleanup
Set rstSales = Nothing
Set rstIndividual = Nothing
Set WeeklyPSTwb = Nothing
Set WeeklyDetail = Nothing
Set xlApp = Nothing
End Sub
