Open Excel Spreadsheet

[DeutchBose]

Is there a way to open an Excel spreadsheet through a module in Access?

 

[Norie]

Yes

But can you be a bit more specific as to want you want to do?

 

[DeutchBose]

The user wants to be able to click a button and have a particular query run, and export the result to an excel spreadsheet, and then have the excel spreadsheet open for him to use.

 

[DaveSwanton77]

Try this procedure. It opens up an instance of Excel in the background writes the data from the query, formats and saves the file.


Public Sub subReportOut()
On Error GoTo Err_subReportOut
' Set up some variables
' First the Excel related vars
Dim ExcelApp As Excel.Application ' The Excel Application
Dim Excelfn As String ' Excel output filename
Dim ExcelRow As Long ' Which row will be written to in Excel
Dim rcount As Long
Dim rng As Excel.Range ' Excel Cell Range
Dim lastcell As Excel.Range
Dim cnn As ADODB.Connection
Dim sql As String ' Variable to hold a SQL line
Dim rs As ADODB.Recordset ' Result set from database
Dim Icount As Integer
Dim i As Integer
Dim ws As Integer
Dim icols As Integer
Dim wb As Excel.Workbook
'------------------------------------------

Set ExcelApp = CreateObject("Excel.Application")
Set wb = ExcelApp.WorkBooks.Add
'ExcelApp.Visible = True 'Unomment to show excel and have control
'ExcelApp.UserControl = True

'Ensures that only one speadsheet in file
ws = wb.Worksheets.Count
ExcelApp.DisplayAlerts = False
If ws > 1 Then
For i = 2 To ws
wb.Sheets("Sheet" & i).Delete
Next i
End If


Set cnn = CurrentProject.Connection
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = cnn
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open "qry_Report" 'Name of your query
End With

'Check whether there's anything to write
rcount = rs.RecordCount
If rcount = 0 Then
MsgBox "No Data to Output", vbExclamation + vbOKOnly, "No Data"
Exit Sub
Else
Icount = rs.Fields.Count
wb.ActiveSheet.Name = "Report" 'Name the Spreadsheet


For icols = 0 To rs.Fields.Count - 1 'Add Field names
wb.ActiveSheet.Cells(1, icols + 1).Value = rs.Fields(icols).Name
Next
'Format Fields
Set lastcell = wb.ActiveSheet.Cells(1, icols)
Set rng = wb.ActiveSheet.Range("A1", lastcell)
With rng.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
With rng.Font
.Name = "Arial"
.Size = 8
.Bold = True
End With

'Write the rest of the records
wb.ActiveSheet.Range("A2").CopyFromRecordset rs

rs.Close
'Name of the file to be saved
Excelfn = Format(Date, "yyyymmdd") & " - Report.xls"
End If

'Format the Report
' Find the last data cell
Set lastcell = wb.ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
Set rng = wb.ActiveSheet.Range("A1", lastcell)
With rng
.Font.Size = 8
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.BorderAround Weight:=xlThin
.Name = "Database"
End With

With wb.ActiveSheet
.Columns("A:IV").EntireColumn.AutoFit
End With


wb.SaveAs Excelfn
wb.Close

ExcelApp.Quit

'MsgBox "Report saved to" & vbCr & Excelfn, vbInformation, "Report Complete"

Exit_subReportOut:
Exit Sub

Err_subReportOut:
MsgBox Err.Description
Resume Exit_subReportOut

End Sub

 

[Norie]

A bit shorter:

Sub Test()
Dim RetVal
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "MyTestQuery", "C:\MyTest.xls"
    RetVal = Shell("Excel.exe MyTest.xls", vbNormalFocus)
End Sub

 

[DeutchBose]

Thank you...it works, however I do run into an issue with the Shell function. The Path I'm connecting to is several folders deep and many of the folder names have spaces in their names, so my code looks something like this:

Dim ExcelExport
ExcelExport = Shell("Excel.exe H:\Folder\Folder 1\Folder 2\Folder 3\Test.xls", vbNormalFocus)

This creates problems as everytime there is a space, the code looks for a separate file entirely. I tried to put the entire path into a variable and then enter the variable in the Shell script, but that doesn't seem to work either.

 

[Norie]

When putting the path in the variable add quotation marks around it using CHR(34).

That may solve the problem.