Open and Close Excel Workbook

  • Thread starter Thread starter Qaspec
  • Start date Start date
Q

Qaspec

From a module run by an macro I need to open and then close a specific excel
file. I'd like to do this without screen updating. Thanks.
 
You will need to add a reference to the excel object library then your code
should look something a little like this:

Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook

Set appExcel = New Excel.Application
Set wkb = appExcel.Workbooks.Open("C:\Temp\aExcelFile.xls", False, False)

wkb.Close
appExcel.Quit

Set wkb = Nothing
Set appExcel = Nothing
 
Here is how you open a workbook and turn screen updating off:

Sub CreateWorkbook(xlApp As Object, xlBook As Object, xlSheet As Object)

On Error Resume Next ' Defer error trapping.
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
blnExcelWasNotRunning = True
Set xlApp = CreateObject("excel.application")
Else
DetectExcel
End If
Err.Clear ' Clear Err object in case error occurred.
'Set Error Trapping back on
On Error GoTo CreateWorkbook_Error
DoEvents
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Add

Here is how you save and close the workbook:

Private Sub SaveWorkbook(xlApp As Object, xlBook As Object, xlSheet As Object)
Dim varGetFileName As Variant 'Path and File Name to Save
Dim strDefaultDir 'Where to save spreadsheet
Dim strDefaultFileName 'Name to Save as
Dim lngFlags As Long 'Flags for common dialog
Dim strFilter As String 'File Display for Common Dialog
Dim strCurrMonth As String 'To create directory name for save
Dim strCurrYear As String 'To create directory name for save

'Position the cursor to print preview entire sheet
On Error GoTo SaveWorkbook_Error

xlBook.Worksheets(1).Activate
xlBook.Worksheets(1).Range("A1").Select


Me.txtStatus = "Report Complete"
Me.Repaint
DoCmd.Hourglass False

'Set up default path and file
strCurrYear = Me.txtCurrYear
strCurrMonth = Me.cboPeriod.Column(1)
'Set up default path and file
strDefaultDir = "\\rsltx1-bm01\busmgmt\Vought " & strCurrYear & "\" &
strCurrYear _
& " Actuals\" & strCurrMonth & "\FFP Charts\"
strDefaultFileName = Me.cboOffering & " Summary " &
Me.cboPeriod.Column(1) _
& " " & Me.txtCurrYear & ".xls"
'Set filter to show only Excel spreadsheets
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)")
'Flags Hides the Read Only Check and Only allow existing files
lngFlags = ahtOFN_HIDEREADONLY Or ahtOFN_OVERWRITEPROMPT
'Call the Open File Dialog
varGetFileName = ahtCommonFileOpenSave( _
OpenFile:=False, _
InitialDir:=strDefaultDir, _
Filter:=strFilter, _
Filename:=strDefaultFileName, _
Flags:=lngFlags, _
DialogTitle:="Save Report")
If varGetFileName <> "" Then
xlBook.SaveAs Filename:=varGetFileName
End If

Me.txtStatus.Visible = False
Me.Repaint
xlBook.Close
If blnExcelWasNotRunning = True Then
xlApp.Quit
Else
xlApp.DisplayAlerts = True
xlApp.Interactive = True
xlApp.ScreenUpdating = True
End If
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
DoCmd.Hourglass (False)


Here is the code for DetectExcel:

Sub DetectExcel()
' Procedure dectects a running Excel and registers it.
Const WM_USER = 1024
Dim hWnd As Long
' If Excel is running this API call returns its handle.
hWnd = FindWindow("XLMAIN", 0)
If hWnd = 0 Then ' 0 means Excel not running.
Exit Sub
Else
' Excel is running so use the SendMessage API
' function to enter it in the Running Object Table.
SendMessage hWnd, WM_USER + 18, 0, 0
End If
End Sub

You can get the code for the common dialog from this site:

http://www.mvps.org/access/api/api0001.htm
 
Back
Top