Read Delivery Failure email ID - sql

I have a macro for reading Email body which is triggered from MS Outlook rules.
Every Email is read but Email from 'Microsoft Outlook' which is a delivery failure email sent by MS exchange server.
I need to read this item to get the email ID which is causing the bounce back.
Sub VBS_GetEmailFromBodyText(anItem AsOutlook.MailItem)
'Email parameters
fromID = anItem.SenderName
toList = anItem.To
emailsubject = anItem.Subject
emailBody = Left(anItem.Body, 10)
receiveTime = anItem.ReceivedTime
'create query String
sqlQuery = "INSERT INTO [myDB].[dbo].[VBStestTable](fromID,toList,emailsubject,emailBody,receiveTime) Values('"& fromID & "','"& toList & "','"& emailsubject & "','"& emailBody & "','"& receiveTime & "')"
'SQL connection code
'------------------------
ConstadOpenStatic = 3
ConstadLockOptimistic = 3
objConnection = CreateObject("ADODB.Connection")
objRecordSet = CreateObject("ADODB.Recordset")
objConnection.Open( _
"Provider = SQLOLEDB; "& _
"Data Source=MyServer;"& _
"Trusted_Connection=Yes;"& _
"InitialCatalog=MyDB;"& _
"User ID=myUser;Password=myPassword;")
'-------------------------
'ended SQL Connection code
 
'RUN SQL Query --Insert records into DB
objRecordSet.Open(sqlQuery, _
objConnection, adOpenStatic, adLockOptimistic)
' Close the DB Connection
objConnection.Close()  
EndSub

What code do you use now for reading and parsing the message body now?
The Outlook object model provides three main ways for working with item bodies:
Body - a string representing the clear-text body of the Outlook item.
HTMLBody - a string representing the HTML body of the specified item.
Word editor - the Microsoft Word Document Object Model of the message being displayed. The WordEditor property of the Inspector class returns an instance of the Document class from the Word object model which you can use to set up the message body.
You can read more about all these ways in the Chapter 17: Working with Item Bodies. It us up to you which way is to choose to read the message body.

Related

Kofax transformation - Update fields on form on validation

I use Kofax Transform to extract data from OCR.
For this i have a form with several inputs. Basically : name, surname, email.
My issue concerns the validation step.
I want to update the input fields on specific event (click on enter when the email field is selected and update the values from a database). On this database table I have 4 fields : id, name, surname and email
It's my first VBA expertience and I have to create a script:
Private Sub FillFormOneEmailValidated(ByVal pXDoc As CASCADELib.CscXDocument)
'define required properties
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim sqlRequest As String
Dim email As String
Dim dbHostServer As String
Dim dbUsername As String
Dim dbPassword As String
Dim dbName As String
Dim dbConnString As String
'Prapare the db connection
Set rs = New ADODB.Recordset : Set cn = New ADODB.Connection
dbHostServer = "127.0.0.1"
dbUsername = "root"
dbPassword = "root"
dbName = "dbtest"
'build the connection string and open connection to database
dbConnString = "Provider=MSDASQL;Driver={MySQL ODBC 5.3 Unicode Driver};
dbConnString = dbConnString & "Server=" & dbHostServer & ";"
dbConnString = dbConnString & "UID=" & dbUsername & ";"
dbConnString = dbConnString & "PWD=" & dbPassword & ";"
dbConnString = dbConnString & "database=" & dbName
'Create recordset and set conncetion
Set rs = New ADODB.Recordset : : Set cn = New ADODB.Connection
cn.ConnectionString = dbConnString
cn.Open
'build query
sqlRequest = "SELECT name, surname, email FROM users WHERE email = " & email
Set rs = cn.Execute(sqlRequest)
'iterate the values of the sql request
On Error Resume Next
rs.MoveFirst
pXDoc.Fields.ItemByName("name") = CStr(sqlRequest("name"))
rs.Close : Set rs = Nothing
cn.Close : Set cn = Nothing
End Sub
Here are my issues :
it seems that this code is not correct.
How can i "observe" an event on the email input (form) in KTA Transform ?
Avoid building sql query like that since its a potential injection risk. Look into using parameters. (Or hope nobody's kid is named bobby drop table, or be subject to a malicious user)
Also passwords in scripts are not recommended.
I'd look into the already built in functionalities of The database locator. And database dialog you can add to your validation mask.
If script is the only possible thing
You can use multiple events to to this. One way as you said is when the field is confirmed ValidationForm_AfterTableCellChanged.
You can see events available to you in the Project builder/Script editor by the dropdown options
enter image description here
Not sure for KTA, but in normal KT you can debug and observe other how methods are doing by enabling the Script debugging in the synchronization options.
The error in the script looks obvious
sqlRequest is your query as String variable. You must get your row data from the recordset. (i have not checked the rest of the script)

Creating table of Outlook Inbox emails in Access

UPDATE:
Current code below in accordance with recommended SQL construct: error in SqlString =
Run-time error '3011': The Microsoft Access database engine could not find the object ". Make sure the object exists and that you spell its name and the path name correctly. If " is not a local object, check your network connection or contact the server administrator.
Of note, I am working on a USAF unclassified network system, and log in via CAC.
Sub InboxImport
Dim SqlString As String
Dim ConnectionString As String
Dim EmailTableName As String
Dim UserIdNum As String
Dim EmailAddr As String
Dim olNS As Outlook.NameSpace
Dim olFol As Outlook.Folder`
Set ol = CreateObject("Outlook.Application")
Set olNS = ol.GetNamespace("MAPI")
Set olFol = olNS.GetDefaultFolder(olFolderInbox)
EmailTableName = "MyInbox" 'My table name
UserIdNum = Environ("USERNAME") '1277523A... acct #
EmailAddr = olFol.Parent.name 'user's email address
ConnectionString = "Outlook 9.0;MAPILEVEL=" & EmailAddr & "|;PROFILE=Default Outlook Profile;TABLETYPE=0;TABLENAME=MyInbox;COLSETVERSION=12.0;DATABASE=C:\Users\" & UserIdNum & "\AppData\Local\Temp\"
SqlString = "SELECT [From] As [Sender], [Sender Name] As SenderName, [Subject Prefix] & [Normalized Subject] As Subject, [Contents] As [Body], [Received] As [ReceivedTime]" & _
" INTO [Email]" & _
" From [" & ConnectionString & "].[MyInbox]"
DoCmd.RunSQL SqlString
end sub
Original text:
I am attempting to pull default Outlook inbox emails into a table within Access. I am able to use the wizard to successfully retrieve emails and populate the various columns and view my current inbox via Access table named "Inbox".
My Access database will be used by several employees at the same time, and I can't ask them to run the wizard for every different computer they log into.
I am using code copied from middle of the page..."Export Outlook Emails to Access table - VBA".
I'm attempting to use
DoCmd.RunSQL "INSERT INTO [Email] " & _
"([Sender], [SenderName], [Subject], [Body], [ReceivedTime])" & _
"VALUES " & _
"'" & objProp(i).Sender & "', '" & _ 'ERROR!
objProp(i).SenderName & "', " & _ 'ERROR!
objProp(i).Subject & "', '" & _
objProp(i).Body & "', '" & _ 'ERROR!
objProp(i).ReceivedTime & "';"
The code stumbles looking at any MailItem property other than .ReceivedTime or .Subject, and those properties throw an error of...
Run-time error '287': Application-defined or object-defined error
For my References - Database:
Visual Basic For Applications
Microsoft Access 15.0 Object Library
OLE Automation
Microsoft Office 15.0 Access database engine Object Library
Microsoft Internet Controls
Microsoft Outlook 15.0 Object Library
I strongly recommend you don't take the tried approach when importing mail from Outlook. Access can natively work with Outlook Data Files in SQL queries. You can, of course, execute these queries using VBA. But it will be way more optimized.
The trick is getting the proper connection string. You can easily obtain the connection string by using the following process:
Create a linked table to the desired outlook folder under External Data -> More -> Outlook folder, choose linked table, select the folder
Use Debug.Print CurrentDb.TableDefs!MyLinkedOutlookFolder.Connect to obtain the connection string, and Debug.Print CurrentDb.TableDefs!MyLinkedOutlookFolder.SourceTableName to obtain the external table name
Execute the following query, using your obtained variables:
SELECT [From] As [Sender], [Sender Name] As SenderName, [Subject Prefix] & [Normalized Subject] As Subject, [Contents] As [Body], [Received] As [ReceivedTime]
INTO [Email]
FROM [ThatConnectionString].[ThatSourceTableName]
Sample connection string:
Outlook 9.0;MAPILEVEL=me#example.com|;PROFILE=Default Outlook Profile;TABLETYPE=0;TABLENAME=Inbox;COLSETVERSION=12.0;DATABASE=C:\Users\Me\AppData\Local\Temp\
Sample source table name:
Inbox
That's all you need, no complex VBA needed.

How to limit the number of results in an LDAP query

I'm programming an Office 2010 Word template that needs to interact with the Active Directory, to retrieve some user info. The user filling out the template can give some input for the search that is used to retrieve the AD info.
I'm using the ADODB Recordset and Command to setup my query:
Public Function GetActiveDirectoryInfo(searchString As String) As Object
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim strQuery, adoRecordset
'remove user input asteriks
searchString = Replace(searchString, "*", "")
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & GLOBAL_LDAP_USER_OU & ">"
' Filter on user objects.
strFilter = "(&(objectCategory=person)(objectClass=user)(|(sn=" & searchString & "*)(cn=" & searchString & "*)))"
' Comma delimited list of attribute values to retrieve.
strAttributes = ACTIVE_DIRECTORY_FIELDS
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";OneLevel"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 10
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
'adoCommand.Properties("Maximum Rows") = 10 'error: read only
On Error GoTo err_NoConnection
' Run the query.
Set adoRecordset = adoCommand.Execute
Set foundItems = adoRecordset
Debug.Print "Found : " & foundItems.RecordCount & " records"
Exit Function
err_NoConnection:
'in case of error: return <nothing>
Debug.Print Err.description
Set GetActiveDirectoryInfo = Nothing
End Function
THis function is part of a User Class in MS Word.
My question: how to prevent the user from retrieving thousands of records? I have been reading about paging, but that seems more like a network-load-thing than actually limiting the search results that will eventually get back to me.
I've tried several things but with no results. For instance setting the MaxRecords or Maximum Rows properties. Both give an error (non existing property for the first, and read only error for the second).
ANy ideas anyone.
MS Office 2010 dutch
ADO Objects 6.0
Thanx!
Unfortunately ADO MaxRecord that limits the number of search results is not implemented for ADsDSObject. The link https://support.microsoft.com/kb/269361 details the workaround to solve the issue.

Display GAL in Excel to get Alias or Email Adress

I am trying to make use of information found in THIS POST.
I have 2 issues:
the following line hangs indefinitly. FIXED--- its just hidden and has no task bar item, simple search told me how to bring to to the front
strAddress = objWordApp.GetAddress(, strCode, False, 1, , , True, True).GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3A00001E")
I need to return something I can use in a TO line, so an ALIAS or a full email address. I have tested this code in WORD and it works perfrectly (remvoing the references to word) except I cannot get the correct information I need. When I pull I get an exchange distinguished name.. I need to convert this somehow to an alias or email address
/o=corperation/ou=administration/cn=my.name
BACKGROUND: the code in the previously mentioned post displayed the OUTLOOK GAL so a user can search/select a contact from it. I want to use the GAL because it can handle the 200,000+ records and includes distrobution lists.
SOFTWARE: This has to function within the OFffice 2010 suite. I don't need any backwords compatibility and future proofing is a minimal concern at the moment.
END RESULT: I basically just want a user to be able to search for a recipient and have that address end up in a cell.
Any hints would be greatly appreciated.
Method One: Using the GetAddress function
Does the following code still hang indefinitely for you?
Set objWordApp = CreateObject("Word.Application")
InputBox "", "", objWordApp.GetAddress(, "<PR_EMAIL_ADDRESS>", False, 1, , , True, True)
Method Two: If you know the username grab it directly
You can maybe use the LDAP directly to get this information:
Public Function GetUserEmail(ByVal userName As String) As String
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT mail FROM 'LDAP://DC=something,DC=co,DC=uk' WHERE objectCategory='user' AND sAMAccountName='" & userName & "'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
If Not objRecordSet.EOF Then
GetUserEmail = objRecordSet.Fields("mail").Value
Else
GetUserEmail = vbNull
End If
End Function
Method Three: Create your own searchable form
You could create your own UserForm to bring back a list of users from the LDAP. You could choose the fields you want to search on and then allow the user to click that item to grab the email address. It's a little messy, but it should load a bit faster, since it'll only search on a name more than 3 characters long.
In this example above I created a query which searches on the givenName or sn field of the LDAP:
Private Sub txtSearch_Change()
If Len(txtSearch) > 3 Then
queryString = txtSearch
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT givenName, sn, mail FROM 'LDAP://DC=something,DC=co,DC=uk' WHERE objectCategory='user' AND (givenName = '*" & queryString & "*' Or sn = '*" & queryString & "*')"
Set objRecordset = objCommand.Execute
lvResults.ListItems.Clear
Do Until objRecordset.EOF
Set li = lvResults.ListItems.Add(, , objRecordset.Fields("givenName").Value)
li.SubItems(1) = objRecordset.Fields("sn").Value
If Not IsNull(objRecordset.Fields("mail")) Then
li.SubItems(2) = objRecordset.Fields("mail").Value
End If
objRecordset.MoveNext
Loop
End If
End Sub
Notes
Something to note, is you will need to change the LDAP string to your company domain controller. For example LDAP://DC=something,DC=co,DC=uk.
If you don't know this you can find it out by doing:
Set sysinfo = CreateObject("ADSystemInfo")
MsgBox sysinfo.userName
Note you only want to take the DC= parts.
A list of all attributes can be found here: http://www.computerperformance.co.uk/Logon/LDAP_attributes_active_directory.htm

Querying Excel by multiple users - Need suggestion

I am seeking one suggestion on how to build an excel macro for below requirement. Request you to provide your valuable comments in EXCEL Only.
Scenario
I have one spreadsheet "Product Master" that contains all the product details.
(i.e. Product ID,Product Name,Product Type,Quantity etc etc)
I am designing a UserForm using excel VBA where anyone can fetch all the details of a product based on its Product ID. Now the product-master sheet where all the product details is present will get updated on a daily basis. And each user should be able to update any details in that sheet based on his requirement.
Questions/Doubts
How do I design my system? I mean where should I put my "Product-Master" spreadsheet so that it can be accessed by multiple users. What I am thinking is to put product-masster on a shared_drive so that all can access that sheet through VBA userform. I will provide excel VBA userform macro to everyone in my office & they will query that sheet present in shared drive. does this seem ok?
Does excel provide facility to Query data from sheet present in shared-drive & update it when required. And I want this to be queried by multiple users at a time.
I know there are other products/technologies that provides better solution than EXCEL. But I want the solution in EXCEL ONLY.
I would appreciate it if anyone can provide his/her valuable comments on this. Let me know in case you need any details.
Thanks you.
Here are some example functions getting data from/posting data to MS Access (took me awhile to dig these up, hah!). This uses a Reference to the Microsoft DAO 3.6 Object Library and will only work with legacy .mdb files, not accdb (because the mdb driver is 100x faster and doesn't have a memory leak.)
Const DBPath As String = "Full\Database\Path"
Function GET_ACCESS_DATA(DBPath, SQL) As Object
Dim dbConn As Object
Dim dbRS As Object
Dim SQL As String
On Error GoTo ErrorHandler
SQL = "Sql Query"
'Set up database connection string
Application.StatusBar = "Connecting to Database..."
'Open database connection
Set dbConn = OpenDatabase(DBPath)
'Run the query
Application.StatusBar = "Running Query..."
Set dbRS = dbConn.OpenRecordset(SQL, DAO.dbOpenForwardOnly, DAO.RecordsetOptionEnum.dbReadOnly)
'If no rows returned, display error message and exit
If dbRS.RecordCount = 0 Then
Application.StatusBar = "Running Query...Error"
MsgBox "There are no records for the selected criteria.", vbInformation, "Refresh Data"
Application.StatusBar = "REFRESHING DATA PLEASE WAIT.."
Exit Function
End If
'returns DAO Recordset with the data
Set GET_ACCESS_DATA = dbRS
'A recordset can either be looped through or pasted to a spreadsheet with the Worksheet.Range.CopyFromRecordset method
'Error trap here
End Function
Function POST_TO_ACCESS() As Boolean
POST_TO_ACCESS = False
errormod = "TRACKING"
On Error GoTo ERROR_TRAP:
'START CONTROLS
Application.StatusBar = "Formatting Data"
St_Timer = Timer 'start connection timer
Dim cn As DAO.Database
Set cn = DAO.OpenDatabase(DBPath)
En_Timer = Timer 'get connection time
'SetKey Parameters
UserNM = Replace(User_Name(), Chr(39), "")
CompNm = Environ("COMPUTERNAME")
Elapsed_Time = En_Timer - St_Timer
SQL = "INSERT INTO TBL_TRACKING " & _
"(UserNM) " & _
" VALUES ('" & UserNM & "')"
cn.Execute SQL
cn.Close
'END CONTROLS
Application.StatusBar = False
POST_TO_ACCESS = True
'error trap here
End Function
Function User_Name()
'This just gets the LDAP username of whoever is logged in. Useful for tracking. Not guarenteed to work for your Active Directory :)
Dim WshNetwork
Dim objAdoCon, objAdoCmd, objAdoRS
Dim objUser, objRootDSE
Dim strDomainDN, strUserName, strUserFullName
strUserFullName = ""
Set WshNetwork = CreateObject("WScript.Network")
strUserName = WshNetwork.UserName
Set objRootDSE = GetObject("LDAP://rootDSE")
strDomainDN = objRootDSE.Get("defaultNamingContext")
Set objAdoCon = CreateObject("ADODB.Connection")
objAdoCon.Open "Provider=ADsDSOObject;"
Set objAdoCmd = CreateObject("ADODB.Command")
Set objAdoCmd.ActiveConnection = objAdoCon
objAdoCmd.CommandText = _
"SELECT ADsPath FROM 'LDAP://" & strDomainDN & "' WHERE " & _
"objectCategory='person' AND objectClass='user' AND " & _
"sAMAccountName='" & strUserName & "'"
Set objAdoRS = objAdoCmd.Execute
If (Not objAdoRS.EOF) Then
Set objUser = GetObject(objAdoRS.Fields("ADsPath").Value)
objUser.GetInfoEx Array("displayName"), 0
strUserFullName = objUser.Get("displayName")
Set objUser = Nothing
User_Name = strUserFullName
Else
End If
Set objAdoRS = Nothing
Set objAdoCmd = Nothing
objAdoCon.Close
Set objAdoCon = Nothing
Set objRootDSE = Nothing
Set WshNetwork = Nothing
End Function