VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "xlAppCls" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Base 1 'lower bound of arrays set to 1 (default is 0) Option Explicit 'member declarations 'objects are automatically created on first reference Private mxlApp As Excel.Application 'excel application Private mxlBook As Excel.Workbook 'excel document Private mxlSheet As Excel.Worksheet 'spreadsheet page in workbook Private mxlWorkBookName As String Private mxlSheetName As String 'create new or return existing excel app Private Property Get xlApp() As Excel.Application If mxlApp Is Nothing Then Set mxlApp = GetExcelObject End If If (Len(mxlWorkBookName) > 0) And Not (mxlApp Is Nothing) Then If (mxlApp.Workbooks.Count > 0) Then Set mxlBook = mxlApp.Workbooks(1) End If End If Set xlApp = mxlApp End Property 'create new or return existing workbook Private Property Get xlBook() As Excel.Workbook If mxlBook Is Nothing Then Set mxlBook = xlApp.Workbooks.Add End If Set xlBook = mxlBook End Property 'create new or return existing worksheet Private Property Get xlSheet() As Excel.Worksheet If mxlSheet Is Nothing Then If (Len(mxlSheetName) > 0) Then 'if the worksheetname exists grab it Set mxlSheet = xlBook.Worksheets(mxlSheetName) Else Set mxlSheet = xlBook.Worksheets(1) End If End If Set xlSheet = mxlSheet End Property 'set workbook filename, if null, properties will create new workbook Public Property Let xlWorkbookName(ByVal strWorkbookName As String) mxlWorkBookName = strWorkbookName mxlWorkBookName = Trim(mxlWorkBookName) End Property 'return workbook filename Public Property Get xlWorkbookName() As String xlWorkbookName = mxlWorkBookName End Property 'set sheetname (sheet index), if null, properties will create new worksheet Public Property Let xlSheetName(ByVal strSheetName As String) mxlSheetName = strSheetName mxlSheetName = Trim(mxlSheetName) End Property 'return sheetname (sheet index) Public Property Get xlSheetName() As String xlSheetName = mxlSheetName End Property 'wrapper with error handling for GetObject function to get instance of Excel Application Private Function GetExcelObject() As Object Dim IsDebugMode As Boolean Dim isProcRunning As Boolean On Error Resume Next ''' IsDebugMode = TestEnv() 'break on all errors in vb ide to find code bugs 'MsgBox "Is in development environment: " & IsDebugMode ''' If (IsDebugMode) Then ' don't use error handler for excel instance check isProcRunning = FindProcessFromEXE("excel.exe") 'MsgBox "Is Excel Running: " & isProcRunning If (isProcRunning) Then 'grab the running instance Set GetExcelObject = GetObject(, "Excel.Application") Else 'create a new instance Set GetExcelObject = New Excel.Application 'create Excel application If (Len(xlWorkbookName) > 0) Then 'have workbookname GetExcelObject.Workbooks.Open xlWorkbookName 'open selected workbook End If End If ''' Else 'if excel is running grab it, else (on error) create new instance ''' 'Set GetExcelObject = CreateObject("Excel.Application") ''' If Err.Number <> 0 Then 'excel app is not running ''' Err.Clear 'clear Err object ''' 'Set GetExcelObject = CreateObject("Excel.Application") 'create Excel application ''' Set GetExcelObject = New Excel.Application 'create Excel application ''' If (Len(xlWorkbookName) > 0) Then 'have workbookname ''' GetExcelObject.Workbooks.Open xlWorkbookName 'open selected workbook ''' End If ''' End If ''' End If End Function Public Function SaveAsExcelWorkbook(strWorkbookIn As String) ', _ 'Optional bCloseWorkbook As Boolean = False) As Object Dim strWorkbook As String strWorkbook = strWorkbookIn If xlApp Is Nothing Then MsgBox "no Workbook" 'no Workbook is open Else If Not (xlApp.ActiveWorkbook Is Nothing) Then If (Len(Trim(strWorkbook)) = 0) Then Do strWorkbook = Application.GetSaveAsFilename Loop Until strWorkbook <> False End If xlApp.ActiveWorkbook.SaveAs filename:=strWorkbook End If End If End Function Public Sub QuitXLApp(Optional bSaveBook As Boolean = False, Optional bCloseBook As Boolean = True) If Not (xlBook Is Nothing) Then 'if created, do ops, (saved=true, =silent close) xlBook.Saved = Not bSaveBook 'set the saved flag to not save book If (bCloseBook) Then xlBook.Close End If If Not (xlApp Is Nothing) Then xlApp.Quit 'quit if xlapp created End Sub Private Sub Class_Initialize() mxlWorkBookName = "" mxlSheetName = "" End Sub Public Function ShowWorkbook() As String Dim strIndex As String Dim varVal As Variant xlApp.Interactive = True 'xlApp.Interactive = False xlApp.Visible = True 'xlApp.Visible = False xlSheet.Activate strIndex = xlSheet.Name ShowWorkbook = strIndex End Function Public Function ActvateWorkSheet(strActiveIndex As String) As String Dim strIndex As String Dim varVal As Variant xlApp.Interactive = True 'xlApp.Interactive = False xlApp.Visible = True 'xlApp.Visible = False mxlSheetName = strActiveIndex Set mxlSheet = xlBook.Worksheets(mxlSheetName) 'use the get xlBook property to autogen objects mxlSheet.Activate strIndex = mxlSheet.Name ActvateWorkSheet = strIndex End Function 'get cell value of current sheet Public Function GetCellValue(idxRow As Long, idxCol As Long) As String GetCellValue = xlSheet.Cells(idxRow, idxCol).value End Function 'set cell value of current sheet Public Sub SetCellValue(idxRow As Long, idxCol As Long, strValue As String) xlSheet.Cells(idxRow, idxCol).value = strValue End Sub