Data Collection Reverse Engineering

  • Thread starter Helen Limehouse
  • Start date

H

Helen Limehouse

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-access/archive/2009/02/09/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
 
H

Helen Limehouse

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
 
Ad

Advertisements

Joined
Mar 23, 2017
Messages
1
Reaction score
0
Helen

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

Paul
 

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. After that, you can post your question and our members will help you out.

Ask a Question

Top