Data Collection Reverse Engineering

Discussion in 'Access' started by Helen Limehouse, Jun 7, 2012.

  1. Hello,

    I am in the process of reverse engineering the data collection functionality (this is where I found out I could do this reverse engineering of this process: http://blogs.office.com/b/microsoft...automate-data-collection-forms-using-vba.aspx) in access 2010, and am running into an issue when creating the html email. I have a vba module which does the following:

    1. Creates a entry in the AccessDCActionFile.xml file, which is what links the html email created later with the access tables to update.

    2. Creates a record in the MsysDataCollection table in access, which also creates a unique GUID. This GUID links this table with the record in the file above and also the html email created later and sent to outlook.

    This is the proc:
    Private Sub AddRecordToXMLFile()

    Dim strFirstQuery, strSecondQuery, strThirdQuery As String
    Dim strPath, strPath1, strPath2 As String
    Dim strData, strResult As String
    Dim strtmp, strfulltmp As String

    'strPath = "c:\clientmatters\AccessDCActionFile.xml" 'Header Information file
    'strResult = "c:\clientmatters\AccessDCActionFile_Updated.xml" 'Result of the three merged files
    FileCopy "c:\users\lime1399\appdata\roaming\microsoft\access\AccessDCActionFile.xml", "c:\users\lime1399\appdata\roaming\microsoft\access\AccessDCActionFile_Input.xml"

    strPath = "c:\users\lime1399\appdata\roaming\microsoft\access\AccessDCActionFile_Input.xml" 'Header Information file
    strResult = "c:\users\lime1399\appdata\roaming\microsoft\access\AccessDCActionFile.xml" 'Result of the three merged files



    Open strPath For Input As #1 'Open Header
    Open strResult For Output As #4 'Open Results File




    Dim db As DAO.Database
    Dim rstAdd As DAO.Recordset
    Dim rstFormID As DAO.Recordset
    Dim rstDataCollection As DAO.Recordset
    Dim rstDataCollectionCopyFrom As DAO.Recordset
    Dim newGUID As String
    Dim Mapping As String
    Dim OutlookFolder As String
    Dim FormID As String

    Set db = CurrentDb
    Set rstAdd = db.OpenRecordset("Table3_Keep")
    Set rstFormID = db.OpenRecordset("FormID")
    Set rstDataCollection = db.OpenRecordset("MsysDataCollection")
    Set rstDataCollectionCopyFrom = db.OpenRecordset("Select Mapping, OutlookFolder, CreatedDate from MSysDataCollection order by CreatedDate desc")

    rstDataCollectionCopyFrom.MoveFirst
    Mapping = rstDataCollectionCopyFrom![Mapping].Value
    OutlookFolder = rstDataCollectionCopyFrom![OutlookFolder].Value
    rstDataCollectionCopyFrom.Close
    Set rstDataCollectionCopyFrom = Nothing

    rstAdd.MoveFirst
    rstAdd.Delete
    rstAdd.AddNew
    rstAdd.Update

    rstAdd.MoveFirst
    newGUID = Mid(rstAdd![ID].Value, 6, 39)
    'rstAdd.Close
    'Set rstAdd = Nothing


    DoCmd.SetWarnings False
    DoCmd.OpenQuery "QryUpdateFormID"

    rstFormID.MoveFirst
    FormID = rstFormID![FormID].Value
    rstFormID.Close
    Set rstFormID = Nothing

    rstDataCollection.MoveLast
    rstDataCollection.AddNew
    rstDataCollection("Active") = -1
    rstDataCollection("BasedOnType") = 1
    rstDataCollection("CreatedDate") = Now()
    rstDataCollection("ExternalID") = rstAdd![ID].Value
    rstDataCollection("FormName") = "Client Matters Update Form"
    rstDataCollection("InfoPathForm") = 0
    rstDataCollection("Mapping") = Mapping
    rstDataCollection("OutlookFolder") = OutlookFolder
    rstDataCollection("SentDate") = Now()
    rstDataCollection.Update

    rstAdd.Close
    Set rstAdd = Nothing

    rstDataCollection.Close
    Set rstDataCollection = Nothing




    Do While Not EOF(1)
    Line Input #1, tmp

    fulltmp = Mid(tmp, 1, InStr(tmp, "</mdb") - 1) & FormID & "</mdbMap><sendingGuids/><lastShutdown>41022.64263455113</lastShutdown></ActionConfigFile>"

    Loop


    Print #4, fulltmp 'Make Merged Results File

    Close #4 'Close Files

    Close #1

    Kill "c:\users\lime1399\appdata\roaming\microsoft\access\AccessDCActionFile_Input.xml"


    CreateEmail2

    End Sub
    -------- End of Proc


    I then create the html email which contains the fields and is formatted as close to the email which access generates for this purpose (if you were to look under the hood at the email that access creates during the data collection process).

    I think here is where my issue resides, as this proc is indeed creating the email, but when the email gets to outlook, it does not contain something I need, as it does not show this when you mouse over the email (which an email created by the data collection process does):
    AccessDataCollection:{F2bfo...GUID here..}.

    Can you please look at my email proc below and let me know what I am missing?
    Private Sub CreateEmail()


    Dim strFirstQuery, strSecondQuery, strThirdQuery As String
    Dim strPath, strPath1, strPath2 As String
    Dim strData, strResult As String
    Dim strtmp, strfulltmp, strfulltmpTop, strfulltmpBottom As String
    Dim ODAttorney As String

    Dim MyOutlook As Outlook.Application
    Set MyOutlook = New Outlook.Application

    Dim MyMail As Outlook.MailItem
    Set MyMail = MyOutlook.CreateItem(olMailItem)

    Dim Subjectline As String
    Dim BodyFile As String





    Subjectline$ = InputBox$("Please enter the subject line for this mailing.", _
    "We Need A Subject Line!")

    Set MyOutlook = New Outlook.Application




    strPath = "c:\clientmatters\Email_HTML.html" 'Email


    Open strPath For Output As #1 'Open Email File


    Dim db As DAO.Database
    Dim rstEmailInserts As DAO.Recordset
    Dim rstEmailTo As DAO.Recordset

    Set db = CurrentDb
    Set rstEmailInserts = db.OpenRecordset("TableEmailInsert")
    rstEmailInserts.MoveFirst
    strfulltmpTop = rstEmailInserts![Section1].Value
    strfulltmpBottom = rstEmailInserts![Section21].Value

    Set rstEmailTo = db.OpenRecordset("Select * from EmailToTable Order by ODAttorneyEmail")
    rstEmailTo.MoveFirst
    ODAttorney = rstEmailTo![ODAttorneyEmail].Value

    strfulltmp = strfulltmpTop

    Do While Not rstEmailTo.EOF

    strfulltmp = strfulltmpTop
    Do While ODAttorney = rstEmailTo![ODAttorneyEmail].Value And Not rstEmailTo.EOF


    If Not rstEmailTo.EOF Then
    ODAttorney = rstEmailTo![ODAttorneyEmail].Value
    Else
    Exit Do
    End If


    strfulltmp = strfulltmp & rstEmailInserts![Section2a].Value & rstEmailTo![Client/Matter#].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section2b].Value & rstEmailTo![Client/Matter#].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section2c].Value & rstEmailTo![Client/Matter#].Value
    'strfulltmp = strfulltmp & rstEmailInserts![Section2].Value & rstEmailTo![Client/Matter#].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section3].Value & rstEmailTo![CaseName].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section4].Value & rstEmailTo![CaseType].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section5].Value & rstEmailTo![LocationofMatter].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section6].Value & rstEmailTo![Court/Venue].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section7].Value & rstEmailTo![CaseDescription].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section8].Value & rstEmailTo![FileDate].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section9].Value & rstEmailTo![CutoffDate].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section10].Value & rstEmailTo![Mediation/Trial Date].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section11].Value & rstEmailTo![Tyco Attorney].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section12].Value & rstEmailTo![Tyco HR Rep].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section13].Value & rstEmailTo![Estimated Budget].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section14].Value & rstEmailTo![CaseStatus].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section15].Value & rstEmailTo![SummaryofCurrentStatus].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section16].Value & rstEmailTo![FullDateofResolution].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section17].Value & rstEmailTo![CaseOutcome].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section18].Value & rstEmailTo![Settlement/Award].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section19].Value & rstEmailTo![DescriptionofCaseOutcome].Value
    strfulltmp = strfulltmp & rstEmailInserts![Section20].Value

    rstEmailTo.MoveNext
    If rstEmailTo.EOF Then
    Exit Do
    End If



    Loop

    strfulltmp = strfulltmp & rstEmailInserts![Section21].Value

    Print #1, strfulltmp



    MyMail.To = ODAttorney
    MyMail.Subject = Subjectline$
    MyMail.HTMLBody = strfulltmp
    MyMail.Send




    Loop

    Set MyOutlook = Nothing



    Close #1 'Close Files

    Close #1
    rstEmailInserts.Close
    Set rstEmailInserts = Nothing
    rstEmailTo.Close
    Set rstEmailTo = Nothing


    End Sub


    Any help would be most appreciated :).

    Thank you,
    Helen Limehouse
     
    Helen Limehouse, Jun 7, 2012
    #1
    1. Advertisements

  2. Hello All - I have resolved this issue myself, and the fix was to add the AccessDataCollection:GUID into the subject line of the email, after several </br> between the actual subject and this tag.

    It is now working as I expected.

    Anyone is welcome to the code if you would also like to reverse engineer the Data Collection process.

    Helen
     
    Helen Limehouse, Jun 7, 2012
    #2
    1. Advertisements

  3. Helen Limehouse

    Paul Buurman

    Joined:
    Mar 23, 2017
    Messages:
    1
    Likes Received:
    0
    Helen

    Is it possible to get the complete code so i can adjust it to my situation.
    Thanks.

    Paul
     
    Paul Buurman, Mar 23, 2017
    #3
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.