UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Import, Access 2016    
 
   
mike60smart
post Mar 12 2018, 04:08 PM
Post#1


UtterAccess VIP
Posts: 12,650
Joined: 6-June 05
From: Dunbar,Scotland


Hi Everyone

Sorry if this is a bit long but I thought I must show as much detail as possible.

I have a process where I am trying to manage Online Booking of courses.

The user runs a rule which copies the EMail messages to an Outlook Folder.

The Outlook Folder is then linked in the Access database.

These emails are then displayed as follows on a Form named "frmOneIndividual" and are displayed as follows:-

Attached File  Imported_Data.JPG ( 75.22K )Number of downloads: 8


There is a Command Button which has the following OnClick Event:-

CODE
Private Sub cmdImport_Click()

    On Error GoTo cmdImport_Click_Error
Call SaveTextToTableIndividual2(Me.txtmemo)
DoCmd.Close , ""
    DoCmd.Close acForm, "frmOneIndividual"
    DoCmd.OpenForm "frmTwoIndividual", acNormal, "", "", , acNormal
    
    On Error GoTo 0
    Exit Sub

cmdImport_Click_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdImport_Click, line " & Erl & "."

End Sub


The Call SaveTextToTableIndividual2(Me.txtmemo) is calling the following Module:-

CODE
Public Sub SaveTextToTableIndividual2(ByVal strText As String)

    Dim rs1 As DAO.Recordset, rs2 As DAO.Recordset
    Dim db As DAO.Database
    Dim strNoFound As String
    Dim nPos As Integer, nPos2 As Integer
    Dim strTextPart As String
    
On Error GoTo err_handler

    Set db = CurrentDb
    
    ' check if all Fields in Email is in tblEmailFields2
    Set rs1 = db.OpenRecordset("tblEmailFields2", dbOpenSnapshot)
    Set rs2 = db.OpenRecordset("TableIndividual2", dbOpenDynaset)
    
    ' add new record to TableIndividual2
    rs2.AddNew
    ' use rs1 for Text field validataion
    With rs1
        .MoveFirst
        While Not .EOF
            nPos = InStr(1, strText, .Fields("LineItemText").Value)
            If nPos = 0 Then
                'It is not in the Email Text, put it in variable
                'for later display to user after processing strText
                strNoFound = strNoFound & .Fields("LineItemText").Value & "" & vbCrLf
                
            Else
                nPos2 = InStr(nPos + Len(.Fields("LineItemText").Value), strText, vbLf)
                If nPos2 = 0 Then nPos2 = InStr(nPos + Len(.Fields("LineItemText").Value), strText, vbCr)
                
                'nPos2 = 0 means we must be at end of text
                If nPos2 = 0 Then
                    strTextPart = ""
                    
                Else
                    strTextPart = Mid(strText, nPos, nPos2 - nPos + 1)
                
                End If
                
                'remove Email Line Item from strTextpart
                strTextPart = Replace(strTextPart, .Fields("LineItemText").Value, "")
                
                'remove Cr and Lf
                strTextPart = Trim(Replace(Replace(strTextPart, vbLf, ""), vbCr, ""))
                
                'save to TableIndividual2
                rs2.Fields(.Fields("FieldName")).Value = strTextPart
                
            End If
            .MoveNext
        Wend
    End With
    
    rs2.Update
            
exit_gracefully:

    If Not (rs1 Is Nothing) Then
        rs1.Close
        Set rs1 = Nothing
    End If
    If Not (rs2 Is Nothing) Then
        rs2.Close
        Set rs2 = Nothing
    End If
    If Not (db Is Nothing) Then Set db = Nothing
    
    ' if there is no error and strNoFound variable is not empty string
    ' show fields in Text Email that is not in our Table2
    ' so he can take action whether to add it to his fields
    ' in Table2 and in tblEmailFields
    If Err.Number = 0 Then
        If strNoFound <> "" Then
                MsgBox "Process completed successfully!" & _
                        vbCrLf & vbCrLf & _
                        "These fields in Text Email is/are not in TableIndividual2:" & _
                        vbCrLf & vbCrLf & _
                        strNoFound & _
                        vbCrLf & vbCrLf & _
                        "You may elect to add this to your TableIndividual2 field definition and " & _
                        " also to tblEmailFields."
        Else
            MsgBox "Process completed successfully!"
            
        End If
    End If
    Exit Sub
    
err_handler:
    MsgBox Err.Number & ": " & Err.Description
    Resume exit_gracefully
    
End Sub


When I run the code the following Form is displayed which should show 2 Records but it only shows the first one.

Can anyone take a look and see why it would not show both records?

Any help appreciated.

Attached File  data.JPG ( 93.13K )Number of downloads: 12


--------------------
Hope this helps?

Mike

Get happiness out of your work or you may never know what happiness is.

Go to the top of the page
 
projecttoday
post Mar 12 2018, 08:10 PM
Post#2


UtterAccess VIP
Posts: 9,816
Joined: 10-February 04
From: South Charleston, WV


The statements
CODE
rs2.AddNew
and
CODE
rs2.Update
are outside the rs1 loop. These statements only get executed once. You need to move these statements inside the loop.

--------------------
Robert Crouser

My company's website
Go to the top of the page
 
mike60smart
post Mar 13 2018, 08:00 AM
Post#3


UtterAccess VIP
Posts: 12,650
Joined: 6-June 05
From: Dunbar,Scotland


Hi Robert

I have moved those two lines to what I think is inside the Loop but It is not working.

CODE
' add new record to TableIndividual2
    
    ' use rs1 for Text field validataion
    With rs1
    rs2.AddNew
        .MoveFirst
        While Not .EOF
            nPos = InStr(1, strText, .Fields("LineItemText").Value)
            If nPos = 0 Then
                'It is not in the Email Text, put it in variable
                'for later display to user after processing strText
                strNoFound = strNoFound & .Fields("LineItemText").Value & "" & vbCrLf
                
            Else
                nPos2 = InStr(nPos + Len(.Fields("LineItemText").Value), strText, vbLf)
                If nPos2 = 0 Then nPos2 = InStr(nPos + Len(.Fields("LineItemText").Value), strText, vbCr)
                
                'nPos2 = 0 means we must be at end of text
                If nPos2 = 0 Then
                    strTextPart = ""
                    
                Else
                    strTextPart = Mid(strText, nPos, nPos2 - nPos + 1)
                
                End If
                
                'remove Email Line Item from strTextpart
                strTextPart = Replace(strTextPart, .Fields("LineItemText").Value, "")
                
                'remove Cr and Lf
                strTextPart = Trim(Replace(Replace(strTextPart, vbLf, ""), vbCr, ""))
                
                'save to TableIndividual2
                rs2.Fields(.Fields("FieldName")).Value = strTextPart
                
            End If
            .MoveNext
        Wend
      rs2.Update
    End With


Any pointers appreciated


--------------------
Hope this helps?

Mike

Get happiness out of your work or you may never know what happiness is.

Go to the top of the page
 
projecttoday
post Mar 13 2018, 09:32 AM
Post#4


UtterAccess VIP
Posts: 9,816
Joined: 10-February 04
From: South Charleston, WV


The loop is While / Wend.

Try changing

CODE
'save to TableIndividual2
rs2.Fields(.Fields("FieldName")).Value = strTextPart


to

CODE
'save to TableIndividual2
rs2.AddNew
rs2.Fields(.Fields("FieldName")).Value = strTextPart
rs2.Update



--------------------
Robert Crouser

My company's website
Go to the top of the page
 
mike60smart
post Mar 13 2018, 11:22 AM
Post#5


UtterAccess VIP
Posts: 12,650
Joined: 6-June 05
From: Dunbar,Scotland


Hi Robert

That works but it creates 14 record vice 2.

It creates a record for each of the required Fields as shown below:-

Attached File  14.JPG ( 165.33K )Number of downloads: 4

--------------------
Hope this helps?

Mike

Get happiness out of your work or you may never know what happiness is.

Go to the top of the page
 
projecttoday
post Mar 13 2018, 11:58 AM
Post#6


UtterAccess VIP
Posts: 9,816
Joined: 10-February 04
From: South Charleston, WV


It's looping thru tblEmailFields2. How many records are in tblEmailFields2? Which ones do you want? You need to restrict it to those.

--------------------
Robert Crouser

My company's website
Go to the top of the page
 
mike60smart
post Mar 13 2018, 12:25 PM
Post#7


UtterAccess VIP
Posts: 12,650
Joined: 6-June 05
From: Dunbar,Scotland


Hi Robert

The fields from that table are shown as follows:-

Attached File  fields.JPG ( 44.2K )Number of downloads: 1


The data is now being stored in the table as shown below instead of in 1 Record.

Attached File  fields2.JPG ( 64.87K )Number of downloads: 3

--------------------
Hope this helps?

Mike

Get happiness out of your work or you may never know what happiness is.

Go to the top of the page
 
projecttoday
post Mar 13 2018, 01:57 PM
Post#8


UtterAccess VIP
Posts: 9,816
Joined: 10-February 04
From: South Charleston, WV


I see. I think you need 2 loops. After it finishes with Michael Lamont it's supposed to do another person, right? How do we know when we've finished with Michael Lamont?

--------------------
Robert Crouser

My company's website
Go to the top of the page
 
mike60smart
post Mar 13 2018, 02:07 PM
Post#9


UtterAccess VIP
Posts: 12,650
Joined: 6-June 05
From: Dunbar,Scotland


Hi Robert

Yes it should check for the fields shown in the Form named "frmOneIndividual" as shown and match them with the fields from "tblEMailFields2"

Attached File  Imported_Data.JPG ( 75.22K )Number of downloads: 2


Attached File  fields.JPG ( 44.2K )Number of downloads: 0


Once it has matched all fields it should then Loop through the next record.

This is what I don't know how to achieve.

--------------------
Hope this helps?

Mike

Get happiness out of your work or you may never know what happiness is.

Go to the top of the page
 
projecttoday
post Mar 13 2018, 02:48 PM
Post#10


UtterAccess VIP
Posts: 9,816
Joined: 10-February 04
From: South Charleston, WV


First, restore the code back to the way it was in your first post. I believe that it's not doing both records is because you have to program it to move to the next record. So when you say

CODE
Call SaveTextToTableIndividual2(Me.txtmemo)


Try changing the above to
CODE
Call SaveTextToTableIndividual2(Me.txtmemo)
DoCmd.GoToRecord , , acNext
Call SaveTextToTableIndividual2(Me.txtmemo)


And see what that does. If it works, then it will have to be replaced with a loop. If not, can you post it?

Is this something that you could do from a form by itself rather than on a record display form?

--------------------
Robert Crouser

My company's website
Go to the top of the page
 
mike60smart
post Mar 13 2018, 03:31 PM
Post#11


UtterAccess VIP
Posts: 12,650
Joined: 6-June 05
From: Dunbar,Scotland


Hi Robert

Great we have progress.

That works when there are just 2 records.

If there are more than 2 then it only deals with the first 2.

Can we add anything to this that would cater for multiple records??


--------------------
Hope this helps?

Mike

Get happiness out of your work or you may never know what happiness is.

Go to the top of the page
 
projecttoday
post Mar 13 2018, 05:34 PM
Post#12


UtterAccess VIP
Posts: 9,816
Joined: 10-February 04
From: South Charleston, WV


Yes -- a loop. Just a moment and I'll post some code.

--------------------
Robert Crouser

My company's website
Go to the top of the page
 
projecttoday
post Mar 13 2018, 05:43 PM
Post#13


UtterAccess VIP
Posts: 9,816
Joined: 10-February 04
From: South Charleston, WV


I think it would be better to loop through the recordset than to move thru the form. Try

CODE
Me.Recordset.MoveFirst
While Not Me.Recordset.EOF
Call SaveTextToTableIndividual2(Me.Recordset.txtmemo)
Me.Recordset.MoveNext
Wend

--------------------
Robert Crouser

My company's website
Go to the top of the page
 
mike60smart
post Mar 14 2018, 04:37 AM
Post#14


UtterAccess VIP
Posts: 12,650
Joined: 6-June 05
From: Dunbar,Scotland


Hi Robert

Tried that and I get the following error:-

Attached File  error.JPG ( 16.5K )Number of downloads: 0


Hit Debug and it highlights the Call Line

Edit***

Changed the following line to this:-

Call SaveTextToTableIndividual2(Me.txtmemo)

Now works a treat.

Will test further and get back to you.


Many Many thanks yet again
thanks.gif

--------------------
Hope this helps?

Mike

Get happiness out of your work or you may never know what happiness is.

Go to the top of the page
 
projecttoday
post Mar 14 2018, 05:34 AM
Post#15


UtterAccess VIP
Posts: 9,816
Joined: 10-February 04
From: South Charleston, WV


Of course! Me.txtmemo is on the form.

Glad it works for you now.

--------------------
Robert Crouser

My company's website
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    16th July 2018 - 11:03 PM