export form to Excel help (1 Viewer)

[is250sp]

I found this code online and it works, however, there are 2 issues.

1. It creates an Excel file called OT Allocation.xls. When I open it, click on Window in the main menu, it actually shows 2 files are opened, the other one called Book 1. Book 1 contians only the header row. When I close OT Allocations.xls, it ask if I want to save Book 1. How can one Excel file open two ones? Where in the VBA code is it doing this?

2. Column A is a date field as mm/dd/yy, however, it writes to the Excel file as a number (General format). How can I format the column as Date?

Private Sub cmdExport_Click()

Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object

'Start a new workbook in Excel
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add

'Add data to cells of the first worksheet in the new workbook
Set oSheet = oBook.Worksheets(1)
oSheet.range("A1").Value = "Period End Dt"
oSheet.range("B1").Value = "Name"
oSheet.range("C1").Value = "OT Pay"
oSheet.range("D1").Value = "Jobcode 1"
oSheet.range("E1").Value = "Task 1"
oSheet.range("F1").Value = "Pct 1"
oSheet.range("G1").Value = "Jobcode 2"
oSheet.range("H1").Value = "Task 2"
oSheet.range("I1").Value = "Pct 2"
oSheet.range("J1").Value = "Jobcode 3"
oSheet.range("K1").Value = "Task 3"
oSheet.range("L1").Value = "Pct 3"
oSheet.range("M1").Value = "Jobcode 4"
oSheet.range("N1").Value = "Task 4"
oSheet.range("O1").Value = "Pct 4"

oSheet.range("P1").Value = "Jobcode 5"
oSheet.range("Q1").Value = "Task 5"
oSheet.range("R1").Value = "Pct 5"

oSheet.range("S1").Value = "Jobcode 6"
oSheet.range("T1").Value = "Task 6"
oSheet.range("U1").Value = "Pct 6"

oSheet.range("A1:U1").Font.Bold = True

Dim rs As Recordset
'Set rs = Me.subResults.Form.Recordset
Set rs = Me.Form.Recordset

Dim iRow As Integer
iRow = 2
Dim iRows As Integer
iRows = rs.RecordCount + 1
Dim test As String


Do While iRow <= iRows
oSheet.range("A" & iRow).Value = rs.Fields(0)
oSheet.range("B" & iRow).Value = rs.Fields(1)
oSheet.range("C" & iRow).Value = rs.Fields(2)
oSheet.range("D" & iRow).Value = rs.Fields(3)
oSheet.range("E" & iRow).Value = rs.Fields(4)
oSheet.range("F" & iRow).Value = rs.Fields(5)
oSheet.range("G" & iRow).Value = rs.Fields(6)
oSheet.range("H" & iRow).Value = rs.Fields(7)
oSheet.range("I" & iRow).Value = rs.Fields(8)
oSheet.range("J" & iRow).Value = rs.Fields(9)
oSheet.range("K" & iRow).Value = rs.Fields(10)
oSheet.range("L" & iRow).Value = rs.Fields(11)
oSheet.range("M" & iRow).Value = rs.Fields(12)
oSheet.range("N" & iRow).Value = rs.Fields(13)
oSheet.range("O" & iRow).Value = rs.Fields(14)
oSheet.range("P" & iRow).Value = rs.Fields(15)
oSheet.range("Q" & iRow).Value = rs.Fields(16)
oSheet.range("R" & iRow).Value = rs.Fields(17)
oSheet.range("S" & iRow).Value = rs.Fields(18)
oSheet.range("T" & iRow).Value = rs.Fields(19)
oSheet.range("U" & iRow).Value = rs.Fields(20)

iRow = iRow + 1
rs.MoveNext
Loop

rs.MoveFirst

'Save the Workbook and Quit Excel
Dim sSave As String
Dim sTime As String
'sTime = Replace(Replace(Now(), ":", "-"), "/", "-")
sSave = "OT Allocations.xls" '& sTime & ".xls"
oBook.SaveAs "C:\" & sSave
oExcel.Quit

Dim result
result = MsgBox("Excel Spreadsheet saved under your C:\" & sSave, _
vbOKOnly, "Export Successful")

End Sub

 

[Guus2005]

I have slightly modified your code and added a reference in Access to the "Microsoft Excel 12.0 Object Library". This way you can use the intellisense provided by Access.

This is not a .NET language so the scope of your variables is not limited to a part of your procedure but to the whole procedure. That's why i prefer to do my dimensioning at the start of the procedure instead of declaring variables on the fly.

Here comes

Private Sub Knop0_Click()
    
    Dim oExcel   As Excel.Application
    Dim oBook    As Excel.Workbook
    Dim oSheet   As Excel.Worksheet
    Dim rs       As Recordset
    Dim iRow     As Integer
    Dim iRows    As Integer
    Dim test     As String
    Dim sSave    As String
    Dim sTime    As String
    Dim result
    
    'Start a new workbook in Excel
    Set oExcel = New Excel.Application
    Set oBook = oExcel.Workbooks.Add
    oExcel.Visible = True
    
    'Add data to cells of the first worksheet in the new workbook
    Set oSheet = oBook.Worksheets(1)
    oSheet.Range("A1").Value = "Period End Dt"
    oSheet.Range("B1").Value = "Name"
    oSheet.Range("C1").Value = "OT Pay"
    oSheet.Range("D1").Value = "Jobcode 1"
    oSheet.Range("E1").Value = "Task 1"
    oSheet.Range("F1").Value = "Pct 1"
    oSheet.Range("G1").Value = "Jobcode 2"
    oSheet.Range("H1").Value = "Task 2"
    oSheet.Range("I1").Value = "Pct 2"
    oSheet.Range("J1").Value = "Jobcode 3"
    oSheet.Range("K1").Value = "Task 3"
    oSheet.Range("L1").Value = "Pct 3"
    oSheet.Range("M1").Value = "Jobcode 4"
    oSheet.Range("N1").Value = "Task 4"
    oSheet.Range("O1").Value = "Pct 4" '
    oSheet.Range("P1").Value = "Jobcode 5"
    oSheet.Range("Q1").Value = "Task 5"
    oSheet.Range("R1").Value = "Pct 5" '
    oSheet.Range("S1").Value = "Jobcode 6"
    oSheet.Range("T1").Value = "Task 6"
    oSheet.Range("U1").Value = "Pct 6"
    
    oSheet.Range("A1:U1").Font.Bold = True
    oSheet.Range("A:A").NumberFormat = "Date"
    iRow = 2
    
    Set rs = Me.Form.Recordset
    iRows = rs.RecordCount + 1
    
    rs.MoveFirst
    
    Do While iRow <= iRows
        oSheet.Range("A" & iRow).Value = rs.Fields(0)
        oSheet.Range("B" & iRow).Value = rs.Fields(1)
        oSheet.Range("C" & iRow).Value = rs.Fields(2)
        oSheet.Range("D" & iRow).Value = rs.Fields(3)
        oSheet.Range("E" & iRow).Value = rs.Fields(4)
        oSheet.Range("F" & iRow).Value = rs.Fields(5)
        oSheet.Range("G" & iRow).Value = rs.Fields(6)
        oSheet.Range("H" & iRow).Value = rs.Fields(7)
        oSheet.Range("I" & iRow).Value = rs.Fields(8)
        oSheet.Range("J" & iRow).Value = rs.Fields(9)
        oSheet.Range("K" & iRow).Value = rs.Fields(10)
        oSheet.Range("L" & iRow).Value = rs.Fields(11)
        oSheet.Range("M" & iRow).Value = rs.Fields(12)
        oSheet.Range("N" & iRow).Value = rs.Fields(13)
        oSheet.Range("O" & iRow).Value = rs.Fields(14)
        oSheet.Range("P" & iRow).Value = rs.Fields(15)
        oSheet.Range("Q" & iRow).Value = rs.Fields(16)
        oSheet.Range("R" & iRow).Value = rs.Fields(17)
        oSheet.Range("S" & iRow).Value = rs.Fields(18)
        oSheet.Range("T" & iRow).Value = rs.Fields(19)
        oSheet.Range("U" & iRow).Value = rs.Fields(20)
        
        iRow = iRow + 1
        rs.MoveNext
    Loop
        
    'Save the Workbook and Quit Excel
    'sTime = Replace(Replace(Now(), ":", "-"), "/", "-")
    sTime = Format(Date, "dd-mm-yyyy hh-mm")
    sSave = "OT Allocations_" & sTime & ".xls"
    oBook.SaveAs "C:\" & sSave
    oExcel.Quit
    
    result = MsgBox("Excel Spreadsheet saved under your C:\" & sSave, _
    vbOKOnly, "Export Successful")
    
End Sub

Share & Enjoy!

 

[is250sp]

I am getting "Compile Error: User-defined type not defined" and the code highlighted is oExcel as Excel.Application

 

[Rabbie]

Have you checked your references. If you don't have the right libraries selected you will get that error. I would guess you need to have Microsoft Excel selected in the reference list. You will find References in the Tools menu of the VBA editor.

 

[is250sp]

I couldn't find Microsoft Excel 12.0 Object Library on the list, so I selected 11, but it works!

Thanks everyone!