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

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


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

    DoCmd.SetWarnings False
    DoCmd.OpenQuery "QryUpdateFormID"

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

    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()

    Set rstAdd = Nothing

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


    Print #4, fulltmp 'Make Merged Results File

    Close #4 'Close Files

    Close #1

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


    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")
    strfulltmpTop = rstEmailInserts![Section1].Value
    strfulltmpBottom = rstEmailInserts![Section21].Value

    Set rstEmailTo = db.OpenRecordset("Select * from EmailToTable Order by ODAttorneyEmail")
    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
    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

    If rstEmailTo.EOF Then
    Exit Do
    End If


    strfulltmp = strfulltmp & rstEmailInserts![Section21].Value

    Print #1, strfulltmp

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


    Set MyOutlook = Nothing

    Close #1 'Close Files

    Close #1
    Set rstEmailInserts = Nothing
    Set rstEmailTo = Nothing

    End Sub

    Any help would be most appreciated :).

    Thank you,
    Helen Limehouse
    Helen Limehouse, Jun 7, 2012
    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 Limehouse, Jun 7, 2012
    1. Advertisements

  3. Helen Limehouse

    Paul Buurman

    Mar 23, 2017
    Likes Received:

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

    Paul Buurman, Mar 23, 2017
    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.