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