By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
449,387 Members | 1,709 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 449,387 IT Pros & Developers. It's quick & easy.

Creating an Excel workbook in Access

P: 2
I have the following code in Access 97:

Public gobjExcel As Object
Public gobjWorkSheet As Object

Set gobjExcel = GetObject(, "Excel.Application")
If Err.Number Then
Set gobjExcel = CreateObject("Excel.Application")
End If

Set gobjWorkSheet = GetObject(File)

If Err.Number Then
gobjWorkSheet = CreateObject(File)
End If
"File" is a string consisting of the path and file name of the Excel file.
This code has worked for years. Now, if the Excel file does NOT exist then the CreateObject(File) has stopped working.
If the Excel file exists then it works correctly.

Can anyone shed light as to why it does not work, or what it needs to work. Or, I can use a snippet that would allow me to create an Excel file in Access, save it and then load the data into it.


Oct 27 '06 #1
Share this Question
Share on Google+
5 Replies

Andrew Thackray
P: 76
You don't need to have an excel file to open and use an excel wrkbook in Acess.

I have a report generator that executes an SQL query into a recordset, opens an excel object, posts and formats the recordset data into a spreadsheet and emails the spreadsheet to a user. The rtelavent code module is :

Sub ExportData(gDir As String, gFile As String, gTitle As String, gSendMail As Boolean, gMonitorID As Long, Frm As Form)

' This subroutine outputs an Excel spreadsheet containing graphs generated from the SQL statement passed
' to it.
' The parameters passed are;
' SQL - the SQL stement that will generate the data for the graph
' gBreak - Yes or No - if yes the first field in the SQL stement will be used to generate a new
' graph each time it changes. The workshhet for the graph will be named from this field. If no
' only one graph will be created.
' gTitle - the text to put as the title of the graph. This will be prefixed with the break field if gBreak = Yes
' XName - the label to use for the X axis
'YName - the label to use for the Y axis

Dim LastBreak, rnge As String
Dim xlApp As Object ' Excel application object
Dim xlBook As Object ' Excel workbook object
Dim xlWks As Object ' Excel worksheet object
Dim iRow, icol, iFirstrow As Integer ' holds row & column references
Dim iLastStart, iLastEnd As Integer
Dim FCheck, Division, fName, SendTo As String
Dim Sheets, Books As Integer
Dim RsData As Recordset
Dim rsMailList As Recordset

Dim dbase As Database
Dim cnt, cnt1 As Long
Set dbase = CurrentDb
Set RsData = dbase.OpenRecordset(SQL, dbOpenForwardOnly)
If RsData.EOF Then ' no data to process
Frm.txtStatusBar = "No records retuned by query..."
Exit Sub ' no data to process
End If
Frm.txtStatusBar = "Creating Spreadsheets"

Sheets = 1
Books = 1
With RsData
GoSub CreateNewBook
' Add data rows to worksheet
Do While Not .EOF
cnt = 0
For icol = cnt To RsData.Fields.Count - 1
xlWks.cells(iRow, icol + 1) = .Fields(icol)
' format the cell
Select Case .Fields(icol).Type
Case dbBigInt, dbByte, dbInteger, dbLong
xlWks.cells(iRow, icol + 1).NumberFormat = "0"
Case dbBinary, dbDouble, dbDecimal, dbFloat, dbNumeric, dbSingle
xlWks.cells(iRow, icol + 1).NumberFormat = "0.00"
Case dbChar, dbText
xlWks.cells(iRow, icol + 1).NumberFormat = "@"
Case dbCurrency
xlWks.cells(iRow, icol + 1).NumberFormat = "$#,##0.00"
Case dbDate
xlWks.cells(iRow, icol + 1).NumberFormat = "m/d/yy h:mm AM/PM"
Case dbDate
xlWks.cells(iRow, icol + 1).NumberFormat = "m/d/yy h:mm AM/PM"
Case dbTime
xlWks.cells(iRow, icol + 1).NumberFormat = "h:mm AM/PM"
Case Else
xlWks.cells(iRow, icol + 1).NumberFormat = "@"
End Select
Next icol
iRow = iRow + 1
End With
GoSub WriteSheet
Set xlWks = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

Exit Sub

' Format sheet
' Send Spreadsheet as Email
'Save worksheet
fName = gDir & gFile & ".xls"
FCheck = ""
FCheck = Dir(fName)
If Len(FCheck) > 0 Then ' the file exists,delete it
Kill fName
End If
xlBook.SaveAs (fName)
' Below one for Window 2000
Shell "C:\Program Files\Office2K\Office\EXCEL.EXE " & fName, vbMaximizedFocus
' Below one for Windows NT
' Shell "C:\Program Files\Microsoft Office\Office\EXCEL.EXE " & fName, vbMaximizedFocus

'Create Excel Spreadsheet
Set xlBook = CreateObject("Excel.Sheet.8")
Set xlWks = xlBook.activesheet
Set xlApp = xlWks.Parent.Parent
xlWks.Name = Left(gTitle, 29)
xlWks.Shapes.AddTextbox(1, 0.75, 0.75, 578.25, 16.5).Select
xlApp.Selection.ShapeRange.Fill.Visible = True
xlApp.Selection.ShapeRange.Fill.ForeColor.SchemeCo lor = 43
xlApp.Selection.ShapeRange.Fill.Transparency = 0#
xlApp.Selection.ShapeRange.Line.Weight = 0.75
xlApp.Selection.ShapeRange.Line.DashStyle = 1
xlApp.Selection.ShapeRange.Line.Style = 1
xlApp.Selection.ShapeRange.Line.Transparency = 0#
xlApp.Selection.ShapeRange.Line.Visible = True
xlApp.Selection.ShapeRange.Line.ForeColor.SchemeCo lor = 64
xlApp.Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
xlApp.Selection.Characters.Text = DataNotes
With xlApp.Selection.Characters.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = -4142
.ColorIndex = -4105
End With
xlApp.Selection.ShapeRange.ScaleWidth 1.52, False, 0

' Enter passed data
iRow = 2
If HeadCount > 0 Then
For cnt = 0 To HeadCount - 1
For cnt1 = 0 To HeadCols - 1
xlWks.cells(iRow + cnt, cnt1 + 1) = Headings(cnt, cnt1)
Next cnt1
Next cnt
End If
'Create column headings
cnt = 0
iRow = iRow + HeadCount + 1
For icol = 0 To RsData.Fields.Count - 1
xlWks.cells(iRow, icol + 1) = RsData.Fields(icol).Name
With xlWks.cells(iRow, icol + 1).Interior
.ColorIndex = 33
.Pattern = 1
End With
With xlWks.cells(iRow, icol + 1).Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = -4142
.ColorIndex = -4105
.Bold = True
End With
Next icol
iRow = iRow + 1

End Sub
Oct 27 '06 #2

P: 2
Andrew, thanks very much for the reply. It is much appreciated and I will implement it later today (I hope).

Would anyone have any idea as to why the CreateObject(File) does not work anymore. It did for years and something changed.


Oct 27 '06 #3

Expert Mod 15k+
P: 31,662
Not repeating all that again - too big
Post mode doesn't do your code justice.
If you repost with the tags around it - it will keep its formatting better.
Also it can, more easily, be copied and pasted to test and reuse.
I, for one, plan to nick bits ;-)

Would anyone have any idea as to why the CreateObject(File) does not work anymore. It did for years and something changed.
No clue there I'm afraid Joe.
Oct 27 '06 #4

Expert Mod 10K+
P: 14,534

Would anyone have any idea as to why the CreateObject(File) does not work anymore. It did for years and something changed.
Things like this happen when libraries get upgraded or 'drop' for some reason.

In the VB Editor go to Tools - References and see if any of the libraries are marked as missing.
Oct 28 '06 #5

Andrew Thackray
P: 76

If you want to implement this module as is be aware there are two things not mentioned.

One is that there is a global array set in a module called Headings

Global Headings(5,5) as string

This is used to pass the spreadsheet headings to the routine & are set by the calling procedure. The number of Heading Rows & Columns are passed in the global variables

Global HeadCount as integer
Global HEadCols as integer

The other is rhat this module does not Email the spreadsheet. It displays it on the screen. Hence check the two lines containing EXCEL.EXE and make sure the path is correct for your system.

If you want to email the spreadsheet replace the lines where EXCEL.EXE is called with a section of code that opens a MAPI session, formats an EMail & appends the workbook object to it and uses an address list passed to the routine as the receipient.
Oct 28 '06 #6

Post your reply

Sign in to post your reply or Sign up for a free account.