Source code for Issue Number 82

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home

Source Code

Create a new class module and paste this source code into it. You should name this class cExcelIntegration. If you have any questions, email us at help@codeoftheweek.com

'----------------------------------------------------------------------
'
'   Module Name:    cExcelIntegration
'   Written By:     C&D Programming Corp.
'   Create Date:    3/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Private oExcelApp As Excel.Application

Public Filename As String                   ' Currently opened filename
Private msWorkbookName As String            ' handle of the workbook currently opened.
Private mvFileFormat As Excel.XlFileFormat  ' type of file currently opened or about to be saved.

Private Sub Class_Initialize()
    Set oExcelApp = Nothing
End Sub

Private Sub Class_Terminate()
    If AppIsOpened Then
        oExcelApp.Quit
    End If
End Sub

'
'   Returns True if this class opened a copy of Excel.
'
Public Property Get AppIsOpened() As Boolean
    AppIsOpened = Not (oExcelApp Is Nothing)
End Property

'
'   Opens an instance of Microsoft Excel.
'
Public Sub AppOpen(bVisible As Boolean)
    If Not AppIsOpened Then
        Set oExcelApp = New Excel.Application
    End If
    oExcelApp.Visible = bVisible
End Sub

Public Sub AppClose()
    If AppIsOpened Then
        oExcelApp.Quit
    End If
End Sub

Private Sub AppCheck()
    If AppIsOpened Then
        Exit Sub
    Else
        AppOpen True    ' make visible by default
    End If
End Sub

Public Sub FileOpen()
    On Error GoTo Handler
    AppCheck
    oExcelApp.Workbooks.Open Filename
    ' retrieves the workbook name that will be use in the workbook collection.
    ' this is usually the same as the filename portion of the full filename to
    ' open.
    msWorkbookName = oExcelApp.ActiveWorkbook.Name
    mvFileFormat = oExcelApp.Workbooks.Item(msWorkbookName).FileFormat
    Exit Sub

Handler:
    Err.Raise Err.Number, "FileOpen", Err.Description
End Sub

Public Sub FileClose(bSave As Boolean)
    On Error GoTo Handler
    AppCheck
    If bSave Then
        oExcelApp.Workbooks(msWorkbookName).Save
    End If
    Call oExcelApp.Workbooks(msWorkbookName).Close
    Exit Sub

Handler:
    Err.Raise Err.Number, "FileClose", Err.Description
End Sub

Public Sub FileSave()
    On Error GoTo Handler
    AppCheck
    Call oExcelApp.Workbooks(msWorkbookName).Save
    Exit Sub

Handler:
    Err.Raise Err.Number, "FileSave", Err.Description
End Sub

'
' Refer to the FileFormat property in the help file Vbaxl8.hlp (which
' is usually located in the "C:\Program Files\Microsoft Office\Office"
' folder.  Some of the more common choices are:
'
'       xlCSV - Comma separated values
'       xlDBF3 - dBASE III format
'       xlWK1 - Lotus 1-2-3 Version 1 format
'       xlWK3 - Lotus 1-2-3 Version 3 format
'       xlExcel3 - Excel Version 3.0 format
'
'
Public Property Let FileFormat(vFileFormat As Excel.XlFileFormat)
    mvFileFormat = vFileFormat
End Property

Public Property Get FileFormat() As Excel.XlFileFormat
    FileFormat = mvFileFormat
End Property

Public Sub FileSaveAs()
    On Error GoTo Handler
    AppCheck
    oExcelApp.Workbooks(msWorkbookName).Activate
    Call oExcelApp.Workbooks.Item(msWorkbookName).SaveAs(Filename, FileFormat)
    msWorkbookName = oExcelApp.ActiveWorkbook.Name
    Exit Sub

Handler:
    Err.Raise Err.Number, "FileSaveAs", Err.Description
End Sub