How to create an Excel file with VBA?

Question

Hi

I want to create an Excelfile with Colume names and three named sheets. Is it possible?

The file should be created in a certain folder:
Like:

Dim filefolder as String
filefolder = [Forms]![Alla Val]![EgenPathAnnat]

All cells but Antal and Leverensdag as text

Antal as Integer
Leveransdag as date.

The look of the new file as below

---

Best // Peter Forss Stockholm GMT +1.00

Answer 1

You can use Excel Automation to create the Workbook and save it to a file. Below is a link to an example:

How to automate Microsoft Excel from Visual Basic

Once the Workbook has been created you can use the SaveAs method of the Workbook object to save it to a file.

---

Paul ~~~~ Microsoft MVP (Visual Basic)

Answer 2

Hi Peter,

Just a thought (I can't test the idea right now)... You can also try creating three empty queries named as the tabs in the spreadsheet and then use the TransferSpreadsheet method for each query to save the empty data into the same file name.

Hope it helps...

Answer 3

Hello Peter,

A couple of weeks ago, I spent quite some time trying to make a highly customized excel file for my database with similar idea to what you're doing.  I needed separate tabs and specific formatting.  In my case, I needed a different tab per field in a query/table.  I think if you create a Table just called tblExcelTabs and you can have a field called "TabNAMES" then type out a record per tab you want... for example "Tab 1", "Tab 2", and "Tab 3."  Then you can do a button to create your Excel like.... not tested, but it's a snippet of the code I'm using air typed with what you need (I think).

'*---------------------------------------------------------------------------------------
'* Author    : Batista, J. Alexander, BSN-RN, USN-NC (AD)                                
'*             ...in collaboration with Leo(theDBguy)                                   
'*                                                                                       
'* Website   : http://www.accessmvp.com/thedbguy/                                        
'* Copyright : The following may NOT be altered or reused. This copyright notice MUST be 
'*             left unchanged (including Author, Website and Copyright).  It may not be  
'*             sold/resold or reposted on other sites. Contact author for permissions.   
'*---------------------------------------------------------------------------------------
Private Sub cmdCreateEXL_Click()
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Dim db As DAO.Database
Dim rsTabs As DAO.Recordset
Dim strSQL As String

On Error GoTo errHandler

Set db = CurrentDb()
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Add

'tabs

strSQL = "SELECT DISTINCT Nz(TabNAMES,'Unknown') AS CreateTabNAMES FROM tblExcelTabs"

Set rsTabs = db.OpenRecordset(strSQL, dbOpenSnapshot)

With rsTabs
    Do While Not .EOF
        Set xlWS = xlWB.Sheets.Add
        xlWS.Name = !CreateTabNAMES
        
        'add headers
        xlWS.Cells(1, 1) = "Arktikel"
        xlWS.Cells(1, 2) = "Arktikelben"
        xlWS.Cells(1, 3) = "Antal"
        xlWS.Cells(1, 6) = "Kundnummer"
        xlWS.Cells(1, 7) = "Leveransdag"

        xlWS.Range(xlWS.Cells(1, 1), xlWS.Cells(1, 7)).Font.Bold = True
        
        'alignment
        xlWS.Range(xlWS.Cells(1, 1), xlWS.Cells(1, 7)).HorizontalAlignment = 3
        xlWS.Range(xlWS.Cells(1, 1), xlWS.Cells(1, 7)).Borders.LineStyle = xlContinuous
        xlWS.Columns("A:J").AutoFit
        .MoveNext
    Loop
    .Close
    
End With

'remove extra tabs
If xlWB.Sheets.Count > 1 Then
With xlWB
On Error Resume Next
    .Sheets("Sheet1").Delete
    .Sheets("Sheet2").Delete
    .Sheets("Sheet3").Delete
On Error GoTo 0
End With
Else
xlWB.Close , False
Exit Sub
End If

xlApp.Visible = True

errExit:
    Set rsTabs = Nothing
    Set db = Nothing
    Set xlWS = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing
    Exit Sub
    
errHandler:
    MsgBox Err.Number & ". " & Err.Description
    Resume errExit
    Resume
    
End Sub

EDIT: Fixed a couple of typos and tested this, it works! Just modify it to add your file path and save it instead of just opening. Also format to your preference as described in your post. You can even color code it and set the lengths of each column.

Answer 4

This should be what you're after.

Public Sub GenXLSFile()
    '#Const EarlyBind = True 'Use Early Binding, Req. Reference Library
    #Const EarlyBind = False    'Use Late Binding
    #If EarlyBind = True Then
        'Early Binding Declarations
        Dim oExcel            As Excel.Application
        Dim oExcelWrkBk       As Excel.WorkBook
        Dim oExcelWrSht       As Excel.WorkSheet
    #Else
        'Late Binding Declaration/Constants
        Dim oExcel            As Object
        Dim oExcelWrkBk       As Object
        Dim oExcelWrSht       As Object
        Const xlCenter = -4108
    #End If
    Dim bExcelOpened          As Boolean
    Dim iCols                 As Integer

    'Start Excel
    On Error Resume Next
    Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel

    If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo Error_Handler
        Set oExcel = CreateObject("Excel.Application")
        bExcelOpened = False
    Else    'Excel was already running
        bExcelOpened = True
    End If
    On Error GoTo Error_Handler

    oExcel.ScreenUpdating = False
    oExcel.Visible = False   'Keep Excel hidden until we are done with our manipulation
    Set oExcelWrkBk = oExcel.Workbooks.Add()    'Start a new workbook
    Set oExcelWrSht = oExcelWrkBk.Sheets(1)

    'Delete extra sheets, if any exist
    Do While oExcelWrkBk.Sheets.Count > 1
        oExcelWrkBk.Sheets(1).Delete
    Loop

    'Add the extra 2 sheets we want
    oExcelWrkBk.Sheets.Add after:=oExcelWrSht, Count:=2
    '    oExcelWrkBk.Sheets.Add , , oExcelWrkBk.Worksheets(oExcelWrkBk.Worksheets.Count), 2

    'Rename the newly added sheets
    oExcelWrkBk.Sheets(2).Name = "VaraKunder"
    oExcelWrkBk.Sheets(3).Name = "VaraArtiklar"

    'Populate the first sheet like we want it
    oExcelWrSht.Activate
    With oExcelWrSht
        .Name = "Order"
        oExcelWrSht.Range("A1").Value = "Artikel"
        oExcelWrSht.Range("B1").Value = "Artikelben"
        oExcelWrSht.Range("C1").Value = "Antal"
        oExcelWrSht.Range("F1").Value = "Kundnummer"
        oExcelWrSht.Range("G1").Value = "Leveransdag"
        .Range("A1").Select
    End With

    oExcelWrkBk.SaveAs Forms![Alla Val].Form.[EgenPathAnnat] & "\YourFileName.xlsx", 51

    oExcelWrkBk.Close
    If oExcel.Workbooks.Count < 2 Then
        oExcel.Quit
    End If

Error_Handler_Exit:
    On Error Resume Next
'    oExcel.Visible = True   'Make excel visible to the user
    Set oExcelWrSht = Nothing
    Set oExcelWrkBk = Nothing
    oExcel.ScreenUpdating = True
    Set oExcel = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GenXLSFile" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Sub

The above is general code, but I wasn't sure if the Excel should remain open and display the file or close down...  But this definitely should get you going in the right direction.  You can also use .NumberFormat to format the ranges as you need (Text, Numbers, Date/Time, ...).

---

Daniel Pineault, 2010-2017 Microsoft MVP
Professional Support: http://www.cardaconsultants.com
MS Access Tips and Code Samples: http://www.devhut.net

Answer 5

Thanks all!

I used Daniels code "as is" worked perfectly.

I really, really appreciate the good support you guys gives in this forum!

---

Best // Peter Forss Stockholm GMT +1.00

Answer 6

Hi InnVis

I took some of your lines:

        'Make the column names Bold
         oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), oExcelWrSht.Cells(1, 7)).Font.Bold = True
        'Make the column names fit
         oExcelWrSht.Columns("A:J").AutoFit

Thanks for sharing!

---

Best // Peter Forss Stockholm GMT +1.00