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