Create new Excel file from MS Access in VBA

[Ray Milhon]

I have the following in my Access Database

Private appExcel As Excel.Application
Private wbk As Excel.Workbook, strfilename As String
Private wks As Excel.Worksheet
strfilename = "book1"

Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(strfilename)
Set wks = appExcel.Worksheets("sheet1")

If the file exists this works perfectly. If the file does not exist it
errors.

Eventually I want strfilename to be calculated based on the user so I will
be able to tell who the file was created by.
How do I create a new Excel file from VBA in Access.
I don't see a property under AppExcel.workbooks for new or create.

 

[egerds]

appExcel.workbooks.add

 

[Ray Milhon]

appExcel.workbooks.add

tried that but it tells me the file can't be found.

 

[Ken Snell MVP]

Set appExcel = Excel.Application
If Dir(strfilename) <> "" Then
Set wbk = appExcel.Workbooks.Open(strfilename)
Else
Set wbk = app.Excel.Workbooks.Add
End If
Set wks = wbk.Worksheets("sheet1")

 

[Ray Milhon]

Hi Ken, thanks for the response but I have a question

Set wbk = app.Excel.Workbooks.Add

Shouldn't the strfilename be on this line. If I leave it off the code works
fine but there is no file created or at least I can't find it and if I
include (strfilename) after the .ADD it gives me the error that the file
doesn't exist. What am I forgetting?????

 

[Ken Snell MVP]

When you create a new workbook file, it has "no name" until you save it with
a name. So, if you want to be able to reference the file by the
"strfilename" path and filename, you must add a Save step after you Add the
workbook file.

 

[Ray Milhon]

Here is the entire subroutine:

most of the variables are declared at the module level.


Private Sub Command5_Click()
On Error GoTo err_handler
strfilename = Path & "book4.xlsx"

Dim blnnewfile As Boolean
blnnewfile = False
'
Set appExcel = Excel.Application

If Dir(strfilename) <> "" Then
Set wbk = appExcel.Workbooks.Open(strfilename)
Else
Set wbk = appExcel.Workbooks.Add
blnnewfile = True
End If
Set wks = wbk.Worksheets("sheet1")
Call Set_Headings
Call get_IVHP_Totals
Call Get_subgroups
Call Get_Detail

If blnnewfile Then
appExcel.Save (strfilename)
Else
appExcel.Save
End If
appExcel.Quit



'MsgBox "Checkit now", vbOKOnly, "testing"
exit_routine:
Exit Sub

err_handler:
Dim Errorcode As Integer
Errorcode = MsgBox("Error: " & Err.Description, vbOKCancel, "Error")
If Errorcode = vbOK Then
Resume exit_routine
Else
Resume
End If
End Sub

If I use the xlsx extension 2 files are created but when I try to open the
first file which has the filename I've given it in code. Excel tells me the
format is wrong and the spreadsheet is blank. Immediately after the
appexcel.save (strfilename) code runts I'm prompted for a filename and that
file is saved with the xlsx extension.

If I use the xls extension I get an error that the file doesn't exist even
when using appexcel.save (strfilename)

I'm thinking either there's something I'm leaving out or a reference I've
forgotten.

 

[Ray Milhon]

Here is the entire subroutine:

most of the variables are declared at the module level.


Private Sub Command5_Click()
On Error GoTo err_handler
strfilename = Path & "book4.xlsx"

Dim blnnewfile As Boolean
blnnewfile = False
'
Set appExcel = Excel.Application

If Dir(strfilename) <> "" Then
Set wbk = appExcel.Workbooks.Open(strfilename)
Else
Set wbk = appExcel.Workbooks.Add
blnnewfile = True
End If
Set wks = wbk.Worksheets("sheet1")
Call Set_Headings
Call get_IVHP_Totals
Call Get_subgroups
Call Get_Detail

If blnnewfile Then
appExcel.Save (strfilename)
Else
appExcel.Save
End If
appExcel.Quit



'MsgBox "Checkit now", vbOKOnly, "testing"
exit_routine:
Exit Sub

err_handler:
Dim Errorcode As Integer
Errorcode = MsgBox("Error: " & Err.Description, vbOKCancel, "Error")
If Errorcode = vbOK Then
Resume exit_routine
Else
Resume
End If
End Sub

If I use the xlsx extension 2 files are created but when I try to open the
first file which has the filename I've given it in code. Excel tells me the
format is wrong and the spreadsheet is blank. Immediately after the
appexcel.save (strfilename) code runts I'm prompted for a filename and that
file is saved with the xlsx extension.

If I use the xls extension I get an error that the file doesn't exist even
when using appexcel.save (strfilename)

I'm thinking either there's something I'm leaving out or a reference I've
forgotten.

 

[Ken Snell MVP]

Private Sub Command5_Click()
On Error GoTo err_handler
strfilename = Path & "book4.xlsx"

Dim blnnewfile As Boolean
blnnewfile = False
'
Set appExcel = Excel.Application

If Dir(strfilename) <> "" Then
Set wbk = appExcel.Workbooks.Open(strfilename)
Else
Set wbk = appExcel.Workbooks.Add
' **** save the new workbook with the strfilename path/filename
wbk.SaveAs strfilename
blnnewfile = True
End If
Set wks = wbk.Worksheets("sheet1")
Call Set_Headings
Call get_IVHP_Totals
Call Get_subgroups
Call Get_Detail

Set wks = Nothing
wbk.Save
wbk.Close
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/

 

[Ken Snell MVP]

Private Sub Command5_Click()
On Error GoTo err_handler
strfilename = Path & "book4.xlsx"

Dim blnnewfile As Boolean
blnnewfile = False
'
Set appExcel = Excel.Application

If Dir(strfilename) <> "" Then
Set wbk = appExcel.Workbooks.Open(strfilename)
Else
Set wbk = appExcel.Workbooks.Add
' **** save the new workbook with the strfilename path/filename
wbk.SaveAs strfilename
blnnewfile = True
End If
Set wks = wbk.Worksheets("sheet1")
Call Set_Headings
Call get_IVHP_Totals
Call Get_subgroups
Call Get_Detail

Set wks = Nothing
wbk.Save
wbk.Close
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/