Solved Insert data from a form into a new row of an existing excel spreadsheet

One of your previous attempts had probably left a hidden instance of Excel open. It happens frequently when messing around with Excel automation if you get errors.

If it happens again, open the task manager and scroll down to "Background processes" and see if you have Excel sitting in there. If you do (and assuming you don't actually have Excel open) end the task.
 
Just a quick one if anyone is still watching,

I have updated my creation on the frmPO from the Save button code with this code to allow two different users to select their particular excel files and using wildcards in the file string i am then attempting to insert the data from the form into the appropriate cells in the sheet accordingly.

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 Nz(Me.OrderValue, "") = "" Then
    MsgBox "You must enter the value of the order", vbOKOnly
            Exit Sub
         End If
        
Me.Dirty = False

lngPO = Me!PO
Set rs = Me.RecordsetClone
rs.FindFirst "po = " & lngPO
        
Me.OrderValue.SetFocus
    
Call ImportDocument
    
Set oBook = objExcelApp.Workbooks.Open(Me.SelectedFile.Text, , False, , , , True, , , True)
Set oSheet = oBook.Sheets(1)

If Me.SelectedFile.Text = "order form*" Then

oSheet.Rows("2:2").Select
objExcelApp.Selection.Insert Shift:=xlDown

Set oRange = oSheet.Range("A2")

With oRange
    .Offset(0, 0).Value = rs!PONumber
    .Offset(0, 2).Value = rs!PODate
    .Offset(0, 3).Value = DLookup("OrderedByName", "tblOrderedBy", "OrderedByID = " & Nz(rs!OrderedBy, 0)) & ""
    .Offset(0, 5).Value = rs!Description
    .Offset(0, 7).Value = rs!Quantity
    .Offset(0, 10).Value = rs!OrderValue
    .Offset(0, 18).Value = rs!ETA
    .Offset(0, 19).Value = DLookup("SiteName", "tblSite", "SiteID = " & Nz(rs!SiteID, 0)) & ""
End With

Else
'If Me.SelectedFile.Text = "Orders Placed*" Then

oSheet.Rows("2:2").Select
objExcelApp.Selection.Insert Shift:=xlDown

Set oRange = oSheet.Range("A2")

With oRange
    .Offset(0, 0).Value = rs!PONumber
    .Offset(0, 2).Value = rs!PODate
    .Offset(0, 6).Value = DLookup("OrderedForName", "tblOrderedFor", "OrderedForID = " & Nz(rs!OrderedFor, 0)) & ""
    .Offset(0, 5).Value = rs!Description
    .Offset(0, 7).Value = rs!OrderValue
    .Offset(0, 3).Value = DLookup("SupplierName", "Supplier", "SupplierID = " & Nz(rs!SupplierID, 0)) & ""
    .Offset(0, 4).Value = DLookup("SiteName", "tblSite", "SiteID = " & Nz(rs!SiteID, 0)) & ""
End With

'...

oBook.Save
'Set oSheet = Nothing
oBook.Close savechanges:=True
Set oBook = Nothing

    On Error Resume Next
    DoCmd.GoToRecord , "", acNewRec
    If (MacroError <> 0) Then
        Beep
        MsgBox MacroError.Description, vbOKOnly, ""
            End If


SaveAndNewBtn_Click_Exit:
    Exit Sub

SaveAndNewBtn_Click_Err:
    MsgBox Error$
    Resume SaveAndNewBtn_Click_Exit
    
End If
'End If
End Sub

Needless to say, it isn't working and even using the debugger i am still missing something?
 

Attachments

Without downloading it all - what isn't working?
What error are you getting and where?

If it's in your ImportDocument code we will need to see that?
 
Minty said:
Without downloading it all - what isn't working?
What error are you getting and where?

If it's in your ImportDocument code we will need to see that?
Click to expand...
Hi Minty and thank you for replying.
I am getting the message "Item not found in this collection"

Code: 
Public Function ImportDocument()
    On Error GoTo ErrProc

    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
        .InitialFileName = ""
        .Title = "Dialog Title"
        With .Filters
            .Clear
            .Add "Excel documents", "*.xlsx", 1
        End With
        .AllowMultiSelect = False   'Change this to TRUE to enable multi-select

       'If aborted, the Function will return the default value of Aborted
        If .Show = 0 Then GoTo Leave
    End With

    Dim selectedItem As Variant
    Me.SelectedFile.SetFocus
    For Each selectedItem In fd.SelectedItems
        Me.SelectedFile.Text = selectedItem
    Next selectedItem

Leave:
    Set fd = Nothing
    On Error GoTo 0
    Exit Function

ErrProc:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Function
 
Which line in the code is the error on?
 
Minty said:
Which line in the code is the error on?
Click to expand...
Hi Minty,

The error is on or just after this line after the import document function:

Code: 
Set oBook = objExcelApp.Workbooks.Open(Me.SelectedFile.Text, , False, , , , True, , , True)

After this i get the Macros window appearing

And i also get the error message "Object variable or With block variable not set" when i remove breakpoints?
 
Last edited:
You do not have an excel object?
 
Gasman said:
You do not have an excel object?
Click to expand...
Hi, not sure what you mean as i have never attempted this before. It was all working fine until i added the option for two different users to select their own excel files and since i have attempted to insert the data into them depending on what document is selected
 
Yes I know, but you need to understand the code,at least a little?
You need to set the oexcel object along the lines of
Code: 
Set objexcel = CreateObject("excel application")
Before trying to use it.
I' m on my phone at the hospital right now, so google for correct syntax if that does not work.
 
Gasman said:
You need to set the oexcel object along the lines of
Click to expand...
there is already a code for this mr.gasman.

excel.application is being created and saved to variable when the form Loads.
destroyed, when the form Unload.

test and check again.
 

Attachments

I have not tested anything arnel.?
I was just looking at the code posted.?

As I mentioned I was replying on my android phone, on hospital wifi, so no access to the DB.

Would not make a blind bit of difference if I had access to it, as I had already mentioned the DB is too new for me to open with my version of Access, so I have to go on what has been posted, and I could not see any objexcel in that code being set.?

I'll bow out now anyway, as I appear to be confusing things.
 
arnelgp said:
there is already a code for this mr.gasman.

excel.application is being created and saved to variable when the form Loads.
destroyed, when the form Unload.

test and check again.
Click to expand...
Hi Arnel, now i am getting the message "Item not found in this collection" when i select the file "Orders Placed 21-05-21 to 27-05-21.xlsx"
 
you post which line did you get the error.
again i did not get the error you have.
close your form and check the "TaskManager" (shift-ctrl-esc") and Kill Excel.
re-open your form.
 
arnelgp said:
you post which line did you get the error.
again i did not get the error you have.
close your form and check the "TaskManager" (shift-ctrl-esc") and Kill Excel.
re-open your form.
Click to expand...
Ok, so i found the error.
It was in this line:

.Offset(0, 6).Value = DLookup("OrderedForName", "tblOrderedFor", "OrderedForID = " & Nz(rs!OrderedForID, 0)) & ""

I had " & Nz(rs!OrderedFor, 0)) & "" instead of " & Nz(rs!OrderedForID, 0)) & ""
 
arnelgp said:
you post which line did you get the error.
again i did not get the error you have.
close your form and check the "TaskManager" (shift-ctrl-esc") and Kill Excel.
re-open your form.
Click to expand...
Incidentally can you see anything wrong with this code:

Code: 
Private Sub OrderValue_AfterUpdate()

Dim strTo As String
Dim strMessage As String
Dim strSubject As String
Dim attch As String

    If Nz(Me.OrderValue, "") = "" Or Nz(Me.SiteID.Value, "") = "" Or Nz(Me.OrderedForID.Value, "") = "" Then
    MsgBox "You must enter a Description, Location and who ordered for", _
           vbOKOnly Or vbInformation, "Information required"

If Me.OrderValue > 500 Then
          
        MsgBox "Your Order is above the threshold and needs to be sent for approval ", _
           vbOKOnly Or vbInformation, "Approval required"
        
    strTo = "samsummers60@gmail.com"
  '  strTo = "Mike@summer-isles.com"
    strSubject = "Request for approval"
    strMessage = "Please can you approve this order" & Me.OtherField & Me.OrderValue

    Call SendEmailWithOutlook2(strTo, strSubject, strMessage, attch)
    
    DoCmd.Close , acForm, acSaveYes
    End If
    
    Else
    If Me.OrderValue < 500 Then
    
    Me.PODate.Enabled = True
    Me.OrderedBy.Enabled = True
    Me.Approved.Visible = True
    Me.Label49.Visible = True
    Me.Approved.Value = True
    Me.PODate.SetFocus
    Else

    End If
    
End If

End Sub

I need to allow users to save if the OrderValue is below £500 or request approval if above £500
 
I would question your logic structure.
Does this make more sense?
Code: 
    Dim strTo As String
    Dim strMessage As String
    Dim strSubject As String
    Dim attch As String

    If Nz(Me.OrderValue, "") = "" Or Nz(Me.SiteID.Value, "") = "" Or Nz(Me.OrderedForID.Value, "") = "" Then
        MsgBox "You must enter a Description, Location and who ordered for", _
            vbOKOnly Or vbInformation, "Information required"
        Exit Sub
    End If
   
    If Me.OrderValue > 500 Then
         
        MsgBox "Your Order is above the threshold and needs to be sent for approval ", _
            vbOKOnly Or vbInformation, "Approval required"
       
        strTo = "samsummers60@gmail.com"
        '  strTo = "Mike@summer-isles.com"
        strSubject = "Request for approval"
        strMessage = "Please can you approve this order" & Me.OtherField & Me.OrderValue

        Call SendEmailWithOutlook2(strTo, strSubject, strMessage, attch)
   
        DoCmd.Close , acForm, acSaveYes  ' You do know that this is saving design changes not the data ?
    Else
   
        Me.PODate.Enabled = True
        Me.OrderedBy.Enabled = True
        Me.Approved.Visible = True
        Me.Label49.Visible = True
        Me.Approved.Value = True
        Me.PODate.SetFocus
       
    End If
 
Last edited:
Minty said:
I would question your logic structure.
Does this make more sense?
Code: 
    Dim strTo As String
    Dim strMessage As String
    Dim strSubject As String
    Dim attch As String

    If Nz(Me.OrderValue, "") = "" Or Nz(Me.SiteID.Value, "") = "" Or Nz(Me.OrderedForID.Value, "") = "" Then
        MsgBox "You must enter a Description, Location and who ordered for", _
            vbOKOnly Or vbInformation, "Information required"
        Exit Sub
    End If
   
    If Me.OrderValue > 500 Then
         
        MsgBox "Your Order is above the threshold and needs to be sent for approval ", _
            vbOKOnly Or vbInformation, "Approval required"
       
        strTo = "samsummers60@gmail.com"
        '  strTo = "Mike@summer-isles.com"
        strSubject = "Request for approval"
        strMessage = "Please can you approve this order" & Me.OtherField & Me.OrderValue

        Call SendEmailWithOutlook2(strTo, strSubject, strMessage, attch)
   
        DoCmd.Close , acForm, acSaveYes  ' You do no that this is saving design changes not the data ?
    Else
   
        Me.PODate.Enabled = True
        Me.OrderedBy.Enabled = True
        Me.Approved.Visible = True
        Me.Label49.Visible = True
        Me.Approved.Value = True
        Me.PODate.SetFocus
       
    End If
Click to expand...
Yes that worked thank you.
I will do some final testing over the weekend and let everyone know how I get on.
So many thanks to all of you as always
 
Hi guys - that all works now so a massive thank you as always for all of your guidance and assistance
 
You must log in or register to reply here.

Similar threads

H
How to insert some data from Excel spreadsheet and the other data from Access combo boxes
Replies
6
Views
340
Pat Hartman
P
oxicottin
Solved Import from excel and delete unwanted data
Replies
14
Views
281
oxicottin
oxicottin
L
Consuming an API to retrieve data and store it in a Microsoft Access table.
Replies
3
Views
364
lbcurrier
L
O
VBA Insert Into
Replies
2
Views
558
Pat Hartman
P
N
Solved Importing a Json File into Ms Access Tables
Replies
5
Views
1,204
Josef P.
J

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom