Advertisement
Advertisement
| 06.09.2008 at 10:56AM PDT, ID: 23469908 |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: |
type ClassModule [CExcelMonitor (Code)]
----------------------------------------------------------------------
Option Compare Database
Private wbk As Excel.Workbook
Private WithEvents app As Excel.Application
Private mstrFilePath As String
Private blnKillFile As Boolean
Public Property Set MonitoredWorkbook(wbkIn As Excel.Workbook)
Set wbk = wbkIn
Set app = wbk.Application
mstrFilePath = wbkIn.FullName
End Property
Private Sub app_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
If Wb.FullName = wbk.FullName Then
app.EnableEvents = False
app.Visible = False
AppActivate "Microsoft Access"
If MsgBox("Do you wish to keep a copy of the workbook?", vbQuestion + vbYesNo, _
"Keep workbook?") = vbNo Then
blnKillFile = True
wbk.Close False
Kill mstrFilePath
Else
wbk.Close True
End If
app.Visible = True
app.EnableEvents = True
End If
app.Quit <----------------- Breakpoint
End Sub
------------------------------------------------------------------------
Dim clsMonitor As CExcelMonitor
Private Sub UDLSummaryByBranch()
str_sql1 = "If Exists(SELECT * FROM dbo.SYSOBJECTS WHERE NAME = 'tblUDLSummary' AND TYPE = 'U') DELETE FROM tblUDLSummary"
DoCmd.RunSQL (str_sql1)
Set com = New ADODB.Command
With com
.CommandType = adCmdStoredProc
.CommandText = "dbo.procUDLSummaryByBranch"
.ActiveConnection = CurrentProject.Connection
Set rstQueryFS = .Execute
End With
ExportedFile = strAccessPath0 & strAccessPath7 & "SUMMARY_BY_BRANCH" & "_" & intYearSP & "_" & Format(Now, "mmddhhnnss") & ".XLS"
DoCmd.TransferSpreadsheet acExport, 8, "tblUDLSummary", ExportedFile, True, ""
Beep
MsgBox "Summary By Branch records have been exported to Excel", vbOKOnly, ""
If isFileExist(ExportedFile) Then StartDocACS ExportedFile
DoCmd.Hourglass False
End Sub
Private Sub StartDocACS(filename)
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
'open excel template
Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Open(filename)
Set clsMonitor = New CExcelMonitor
Set clsMonitor.MonitoredWorkbook = xlWB
Set xlWS = xlWB.Worksheets(1)
xlWS.Columns.AutoFit
xlApp.ScreenUpdating = True
End Sub
|