Solved Insert data from a form into a new row of an existing excel spreadsheet (1 Viewer)

[Minty]

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.

 

[Sam Summers]

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.

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?

 

[Minty]

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?

 

[Sam Summers]

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?

Hi Minty and thank you for replying.
I am getting the message "Item not found in this collection"

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

 

[Minty]

Which line in the code is the error on?

 

[Sam Summers]

Which line in the code is the error on?

Hi Minty,

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

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?

 

[Gasman]

You do not have an excel object?

 

[Sam Summers]

You do not have an excel object?

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

 

[Gasman]

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

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.

 

[arnelgp]

You need to set the oexcel object along the lines of

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.

 

[Gasman]

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]

on hospital wifi

anyone sick among your members? regards.

 

[Sam Summers]

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.

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"

 

[arnelgp]

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.

 

[Gasman]

anyone sick among your members? regards.

No, I am a community driver and take people to hospital appointments etc.
Thank you for the thought though.

 

[Sam Summers]

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.

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)) & ""

 

[Sam Summers]

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.

Incidentally can you see anything wrong with this 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

 

[Minty]

I would question your logic structure.
Does this make more sense?

    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

 

[Sam Summers]

I would question your logic structure.
Does this make more sense?

    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

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

 

[Sam Summers]

Hi guys - that all works now so a massive thank you as always for all of your guidance and assistance