Sam Summers
Registered User.
- Local time
- Today, 15:34
- Joined
- Sep 17, 2001
- Messages
- 939
Hi,
I had this working but now need to insert multiple rows for an item (Description) into either one record in Excel or each row into their own row while keeping PONumber, Supplier, SiteID, Date and Ordered for the same.
The main form - frmPO has the continuous subform - StoresTempSubFrm on it that holds the rows of descriptions as entered by the user.
These descriptions are temporarily stored in the table - StoresTemp which is cleared once the items are saved in the Excel spreadsheet.
I created an autonumber field that resets each time in the hope of using the number 1 to however many items are entered as a possible reference but after trying many things from various sites I cannot get it to work and don't really know exactly what i am doing.
Here is the current code i am using which compiles but it is failing at line 49 saying saying does not support object or method?
Any help would be amazing thank you guys
I had this working but now need to insert multiple rows for an item (Description) into either one record in Excel or each row into their own row while keeping PONumber, Supplier, SiteID, Date and Ordered for the same.
The main form - frmPO has the continuous subform - StoresTempSubFrm on it that holds the rows of descriptions as entered by the user.
These descriptions are temporarily stored in the table - StoresTemp which is cleared once the items are saved in the Excel spreadsheet.
I created an autonumber field that resets each time in the hope of using the number 1 to however many items are entered as a possible reference but after trying many things from various sites I cannot get it to work and don't really know exactly what i am doing.
Here is the current code i am using which compiles but it is failing at line 49 saying saying does not support object or method?
Code:
Private Sub SaveAndNewBtn_Click()
On Error GoTo SaveAndNewBtn_Click_Err
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim rs As DAO.Recordset
Dim lngPO As Long
Dim oRange As Range
If Me.OrderedBy.ListIndex < 0 Then
' Cancel = True
MsgBox "You must specify the Person making the Order", vbOKOnly Or vbExclamation, "Selection required"
Me.OrderedBy.SetFocus
End If
Call ImportDocument
If Len(Me.SelectedFile & "") = 0 Then
MsgBox "You did not select any file, record will not be saved."
Exit Sub
End If
'Copies the selected projects from the db to Excel
'Declare variables
Dim startrow, a, b, c As Integer
Dim mypath As String
Dim myvalue As String
Dim rec As Recordset
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim row As Integer
Dim Db As Database
'Turn off pop up warnings
DoCmd.SetWarnings False
'Initialise the database
Set Db = CurrentDb
Set oBook = objExcelApp.Workbooks.Open(Me.SelectedFile)
Set oSheet = oBook.Sheets(1)
oSheet.Rows("1:1").Select
objExcelApp.Selection.Insert Shift:=xlDown
Set oRange = oSheet.Range("A1")
' If Me.SelectedFile.Text = "Orders Placed*" Then
oBook
oSheet(Me.SelectedFile).Offset(0, 5).Value.CopyFromRecordset rs 'Copy recs to sheet
Set wb = Excel.Application.Workbooks.Open(mypath)
'Open the Excel file
Excel.Application.Visible = True
'Set the source table from Access to be copied to Excel
Set rec = Db.OpenRecordset("StoresTemp")
'Set the Worksheet that will accept the copied data
Set ws = wb.Worksheets(Me.SelectedFile)
Sheets("Stores Orders placed").Select
'Count the field headings for the Loop to use
c = CurrentDb.TableDefs("StoresTemp").Fields.Count
'Paste the headings onto the Excel worksheet - adjust the below to suit your headings
ws.Cells(0, 0).Value = rs!PONumber
ws.Cells(0, 2).Value = rs!PODate
ws.Cells(0, 3).Value = DLookup("OrderedByName", "tblOrderedBy", "OrderedByID = " & Nz(rs!OrderedByID, 0)) & ""
ws.Cells(0, 3).Value = rs!PersonFor
ws.Cells(0, 5).Value = DLookup("Description", "StoresTemp", "Criteria= 'string'")
ws.Cells(0, 7).Value = rs!Quantity
ws.Cells(0, 10).Value = rs!OrderValue
ws.Cells(0, 18).Value = rs!ETA
ws.Cells(0, 19).Value = DLookup("SiteName", "tblSite", "SiteID = " & Nz(rs!SiteID, 0)) & ""
'Start pasting on Row 2
startrow = 2 'Cell Row number
'Start pasting in Column 'A'
a = 1 'Cell Column Column number
b = Nz(0, "") 'Table Field number
'b = "" if the field is blank
'c = count of table fields
'Loop through the code until End of File (EOF)
Do Until rec.EOF
Do Until b = c
ws.Cells(startrow, a) = rec.Fields(b).Value
a = a + 1
b = b + 1
'Loop through the data & Paste into Excel until finished
Loop
Cells.Select
With Selection
.WrapText = False
End With
startrow = startrow + 1
rec.MoveNext
a = 1
b = 0
Loop
MsgBox "Data Exported!", vbCritical, "Export Successful"
'Save workbook & Unset variables
wb.Save
wb.Close
Set ws = Nothing
Set rec = Nothing
Set wb = Nothing
Set Db = Nothing
'Turn on pop up warnings
DoCmd.SetWarnings True
SaveAndNewBtn_Click_Exit:
Exit Sub
SaveAndNewBtn_Click_Err:
MsgBox Error$
Resume SaveAndNewBtn_Click_Exit
End SubAny help would be amazing thank you guys
Attachments
-
Excel Sheet.png -
Form Design view.png -
Form View.png -
StoresTemp Table.png
