GP/QTP Automation: interface class for Excel.VBA macro

Categories: Great PlainsSource code


All related posts: Reference Page – GP/QTP Automation

The following object implements interface from QTP side.

Function Libary Source Code

Used resources: Service Functions – String (QTP, VBScript)

Class dexInterface 
'' Properties 
 'Great Plains Dynamics Application COM Reference
 Public GPApp 
 'Dexterity Form Object collection (dynamically mapped)
 Private DexForms 
 'Excel.Application COMReference
 Public XLHandle
 Private XLBook 
'' Methods 
 Public Function SetGPHook()
 Set GPApp = GetObject("", "Dynamics.Application") 
 Set DexForms = Nothing
 Set DexForms = CreateObject("Scripting.Dictionary")
 End Function
 Public Function ReleaseGPHook()
 Set GPApp = Nothing
 Set DexForms = Nothing
 End Function
 Public Function InitWrapper(ByVal sFileName)
 Dim FSO, boolRC 
 Set FSO = CreateObject("Scripting.FileSystemObject")
 boolRC = FSO.FileExists(sFileName)
 Set FSO = Nothing
 If Not boolRC Then
 InitWrapper = FALSE
 Exit Function
 End If 
 Set XLHandle = CreateObject("Excel.Application")
 XLHandle.DisplayAlerts = False 
 Set XLBook = XLHandle.WorkBooks.Open(sFileName) 
 XLHandle.Run("Init") 
 InitWrapper = TRUE 
 End Function
 Public Function CloseWrapper()
 XLHandle.Run("Done") 
 XLBook.Save
 XLBook.Close 
 XLHandle.Quit 
 Set XLBook = Nothing
 Set XLHandle = Nothing 
 End Function
 Public Function RetrieveParameters()
 Dim objResult
 Dim objUsedRange 
 Set objResult = CreateObject("Scripting.Dictionary")
 Set objUsedRange = XLBook.Worksheets(1).UsedRange() 
 objResult.Item("Var1") = objUsedRange.Cells(2,1)
 objResult.Item("Var2") = objUsedRange.Cells(2,2)
 objResult.Item("Var3") = objUsedRange.Cells(2,3)
 objResult.Item("Var4") = objUsedRange.Cells(2,4)
 objResult.Item("Var5") = objUsedRange.Cells(2,5) 
 Set RetrieveParameters = objResult 
 End Function
 Public Function ListFindItem(ByVal sName, ByRef objParameter)
 Dim boolRC, intRC
 Dim boolMatchCase, boolRegex, boolFindIndex
 Dim objRecord, objUsedRange
 Dim sValue, sContent, dvContent, Iter, sItem 
 'init
 boolMatchCase = InitBool(objParameter.Item("match_case"), TRUE)
 boolRegex = InitBool(objParameter.Item("use_regex"), FALSE)
 boolFindIndex = InitBool(objParameter.Item("find_index"), FALSE)
 If Not boolMatchCase Then
 sValue = Trim(LCase(objParameter.Item("arg1")))
 Else
 sValue = Trim(objParameter.Item("arg1"))
 End If 
 'sanscript
 Set objUsedRange = XLBook.Worksheets(1).UsedRange()
 objUsedRange.Cells(2,1) = " " & sName 'space char is apostrophe workaround
 GPApp.Activate()
 XLHandle.Run("GetListContent")
 Set objRecord = RetrieveParameters()
 intRC = objRecord.Item("Var5")
 If intRC <> 0 Then
 objParameter.Item("error") = objRecord.Item("Var4")
 ListFindItem = FALSE
 Exit Function
 End If
 sContent = objRecord.Item("Var1")
 objParameter.Item("contents") = objRecord.Item("Var1") 
 dvContent = Split(sContent, Chr(10)) 
 'first exit condition
 If boolFindIndex Then
 Iter = CInt(sValue)
 If Iter > UBound(dvContent)+1 Then
 objParameter.Item("error") = "Index out of range"
 ListFindItem = FALSE
 Exit Function
 End If
 objParameter.Item("item.index") = Iter-1
 objParameter.Item("item.value") = dvContent(Iter-1)
 ListFindItem = TRUE
 Exit Function
 End If 
 'Search for
 For Iter = 0 To UBound(dvContent) 
 If Not boolMatchCase Then
 sItem = LCase(dvContent(iter))
 Else
 sItem = dvContent(iter)
 End If 
 If boolRegex Then
 boolRC = Regex_Test(sItem, sValue)
 Else
 boolRC = (Trim(sItem) = sValue)
 End If 
 If boolRC Then
 objParameter.Item("item.index") = Iter
 objParameter.Item("item.value") = dvContent(Iter)
 ListFindItem = TRUE
 Exit Function
 End If 
 Next 
 ListFindItem = FALSE 
 End Function
 Public Function GetDexFormByName(ByVal sName)
 Dim FormIter
 Dim objForm, sFormName 
 'Check if mapped
 If DexForms.Exists(sName) Then
 Set GetDexFormByName = DexForms.Item(sName)
 Exit Function
 End If 
 'Look up and map 
 Set objForm = GPApp.GetFirstForm()
 Do
 If Not (objForm is Nothing) Then
 sFormName = objForm.GetName()
 DexForms.Add sFormName, objForm 
 If LCase(sFormName) = LCase(sName) Then
 Set GetDexFormByName = objForm
 Exit Function
 End If 
 End If 
 Set objForm = GPApp.GetNextForm()
 FormIter = FormIter + 1
 Loop While FormIter <= GPApp.CountForms() 
 Set GetDexFormByName = Nothing 
 End Function
 Public Function GetDexWindowByName(ByVal sFormName, ByVal sWinName)
 Dim objForm 
 Set objForm = GetDexFormByName(sFormName)
 If objForm is Nothing Then
 Set GetDexWindowByName = Nothing
 Exit Function
 End If 
 Set GetDexWindowByName = objForm.GetWindow(sWinName) 
 End Function
End Class

Declare and initialize:

Public GPHandle
Public Sub GPHandleInit
Set GPHandle = new dexInterface
End Sub

  • Leave a Reply

    * Required
    ** Your Email is never shared

Creative Commons Attribution-NonCommercial-NoDerivs 3.0 Unported
This work by the author is licensed under a Creative Commons Attribution-NonCommercial-NoDerivs 3.0 Unported.