Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 634
  • Last Modified:

Create executable from vbs

Hi Experts,
This is related to following question.
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_26853882.html

When I try to implement price object it give's error as in attached image file.

Seems following function is not implemented correctly on the DoRequest function.

DfsCmd.DataPending

I changed to Dfs as DfsCmd, but still same error occurs.

Please help me.

BR Dushan.
Call Main


Function DoRequest(obj, lTimeOutMilliseconds, bRequestNext)
    DoRequest = False
    
    Const SLEEP_VALUE = 200
    Dim bTimeoutCheck
    Dim lTimeCount
    Dim state
    Dim lErrorNumber
    Dim strErrorDescription

    ' Handle any automation exception errors generated when calling Request method
    On Error Resume Next

    If (bRequestNext) Then
        obj.RequestNext
    Else
        obj.Request
    End If

    lErrorNumber = Err.Number

    strErrorDescription = Err.Description

    On Error GoTo 0

    If lErrorNumber <> 0 Then
        MsgBox "An automation exception error occurred with the request: " & strErrorDescription
        Exit Function
    End If

    bTimeoutCheck = (lTimeOutMilliseconds > 0)
    lTimeCount = 0
    state = obj.state

    Do Until state <> DfsCmd.DataPending
        ' Check if timeout occurred
        If bTimeoutCheck And lTimeCount >= lTimeOutMilliseconds Then Exit Do

        DoEvents ' Allow system events to be processed while looping
        WScript.Sleep SLEEP_VALUE
        state = obj.state
        ' Increment time counter if checking for timeouts
        If bTimeoutCheck Then lTimeCount = lTimeCount + SLEEP_VALUE
    Loop

    Select Case state
        Case DfsCmd.Error
            MsgBox "An error occurred with the request: " & obj.Error
        Case DfsCmd.DataReady
            DoRequest = True

        Case DfsCmd.DataIncomplete
            MsgBox "The data was incomplete at the time of the request. Please try again later!"
        Case DfsCmd.DataMorePending
        '    DoRequest obj, lTimeOutMilliseconds, True
         MsgBox "Request Data More Pending!"
        Case Else
            ' Determine if timeout occurred
            If (lTimeOutMilliseconds > 0) And (lTimeCount >= lTimeOutMilliseconds) Then
                MsgBox "Request timeout occurred!"
            Else

                MsgBox "Unexpected Error in Request"
            End If
    End Select
End Function


Sub Main()
    Set dataMgr = CreateObject("Dfs.DataManager")
  '  Set price = DfsPrice.DataPrice
    Set price = dataMgr.CreateOb("Price")

   
    'Set the Request Parameters
    price.Security(0) = "ARC"
    price.Exchange(0) = "EWG"
    price.Security(1) = "HUJ"
    price.Exchange(1) = "KYM"
    price.Security(2) = "OTQ"
    price.Exchange(2) = "ZSA"

    
    'Make the request and wait until the data is returned
    iTimout = 20000
    bReqNext = False
    If Not DoRequest(price, iTimeOut, bReqNext) Then WScript.Quit
    
    'Process the data returned
    Dim i
    For i = 0 To price.RowCount - 1
        MsgBox price.Security(i) & price.LastPriceDouble(i) & price.AskFlag(i) & price.AskNumLong(i) & vbCrLf
        MsgBox price.AskPriceDouble(i) & price.AskVolumeDouble(i) & price.BidFlag(i) & price.BidNumLong(i) & BidPriceDouble(i) & vbCrLf

        MsgBox price.BidVolumeDouble(i) & price.CumValueDouble(i) & price.CumVolumeDouble(i) & price.HighPriceDouble(i) & price.LowPriceDouble(i) & vbCrLf
        MsgBox price.MktValueDouble(i) & price.MktVolumeDouble(i) & price.MovementDouble(i) & price.QuoteBasis(i) & price.StatusNotes(i) & vbCrLf
        MsgBox price.ReportCode(i) & price.TradeDate(i) & price.TradeTime(i) & price.UpdateTime(i) & vbCrLf

        MsgBox price.UnadjustedLastPrice(i) & price.Units(i) & price.NumberOfTrades & vbCrLf
    Next
End Sub

Open in new window

DfsCmd-not-found.JPG
0
Dushan De Silva
Asked:
Dushan De Silva
  • 5
  • 5
1 Solution
 
RobSampsonCommented:
Hi, in the DoRequest function, change all instances of
DfsCmd.

to
datamgr.

or
obj.

and see what happens.

Regards,

Rob.
0
 
Dushan De SilvaTechnology ArchitectAuthor Commented:
Hi RobSampson,
Thanks a lot again!

datamgr. is giving same above error.
obj. is giving error in attached image.

BR Dushan.
obj-error.JPG
0
 
RobSampsonCommented:
Hmmmm, try
dataMgr.

again, but also, above this line:
Call Main

add this:
Dim dataMgr

and see what you get.

Regards,

Rob.
0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

 
Dushan De SilvaTechnology ArchitectAuthor Commented:
I kept following line on the top of the code.
Dim dataMgr
And Changed datamgr to dataMgr.
It's giving the same error on the image which I've attached last.

BR Dushan
0
 
RobSampsonCommented:
OK then.  Somewhere, these five values with be constant integers defined somehow:

DfsCmd.DataPending
DfsCmd.Error
DfsCmd.DataReady
DfsCmd.DataIncomplete
DfsCmd.DataMorePending

What you will need to do, is use code in Excel, add the right references, and then add:
MsgBox "DataPending: " & DfsCmd.DataPending & VbCrLf & _
   "Error: "  & DfsCmd.Error & VbCrLf & _
   "DataReady: " & DfsCmd.DataReady & VbCrLf & _
   "DataIncomplete: " & DfsCmd.DataIncomplete & VbCrLf & _
   "DataMorePending: " & DfsCmd.DataMorePending

Then, when you see that MsgBox, post that here, and I'll show you how to add constants for it.

Regards,

Rob.
0
 
Dushan De SilvaTechnology ArchitectAuthor Commented:
Hi RobSampson,
You really really helpful!
It gives attached output of image "dfsCmd_int.JPG".
I tried attached code and it gives "DoEvent.JPG" error.

Do Until state <> 1
        ' Check if timeout occurred
        If bTimeoutCheck And lTimeCount >= lTimeOutMilliseconds Then Exit Do

        DoEvents ' Allow system events to be processed while looping
        WScript.Sleep SLEEP_VALUE
        state = obj.state
        ' Increment time counter if checking for timeouts
        If bTimeoutCheck Then lTimeCount = lTimeCount + SLEEP_VALUE
    Loop

    Select Case state
        Case 3
            MsgBox "An error occurred with the request: " & obj.Error
        Case 2
            DoRequest = True

        Case 4
            MsgBox "The data was incomplete at the time of the request. Please try again later!"
        Case 5
        '    DoRequest obj, lTimeOutMilliseconds, True
         MsgBox "Request Data More Pending!"
        Case Else
            ' Determine if timeout occurred
            If (lTimeOutMilliseconds > 0) And (lTimeCount >= lTimeOutMilliseconds) Then
                MsgBox "Request timeout occurred!"
            Else

                MsgBox "Unexpected Error in Request"
            End If
    End Select

Open in new window

dfsCmd-int.JPG
DoEvent.JPG
0
 
Dushan De SilvaTechnology ArchitectAuthor Commented:
Hi RobSampson,

If I comment 'DoEvents line, then it will return the data, but only one message box is popping, not continuously coming.

BR Dushan.
0
 
RobSampsonCommented:
So if you use this, what output do you get, and what are you expecting?

Rob.
Call Main


Function DoRequest(obj, lTimeOutMilliseconds, bRequestNext)
    DoRequest = False
    
    Const SLEEP_VALUE = 200
    Const DFS_DATAPENDING = 1
    Const DFS_ERROR = 3
    Const DFS_DATAREADY = 2
    Const DFS_DATAINCOMPLETE = 4
    Const DFS_DATAMOREPENDING = 5
    
    Dim bTimeoutCheck
    Dim lTimeCount
    Dim state
    Dim lErrorNumber
    Dim strErrorDescription

    ' Handle any automation exception errors generated when calling Request method
    On Error Resume Next

    If (bRequestNext) Then
        obj.RequestNext
    Else
        obj.Request
    End If

    lErrorNumber = Err.Number

    strErrorDescription = Err.Description

    On Error GoTo 0

    If lErrorNumber <> 0 Then
        MsgBox "An automation exception error occurred with the request: " & strErrorDescription
        Exit Function
    End If

    bTimeoutCheck = (lTimeOutMilliseconds > 0)
    lTimeCount = 0
    state = obj.state

    Do Until state <> DFS_DATAPENDING
        ' Check if timeout occurred
        If bTimeoutCheck And lTimeCount >= lTimeOutMilliseconds Then Exit Do

        'DoEvents ' Allow system events to be processed while looping
        WScript.Sleep SLEEP_VALUE
        state = obj.state
        ' Increment time counter if checking for timeouts
        If bTimeoutCheck Then lTimeCount = lTimeCount + SLEEP_VALUE
    Loop

    Select Case state
        Case DFS_ERROR
            MsgBox "An error occurred with the request: " & obj.Error
        Case DFS_DATAREADY
            DoRequest = True

        Case DFS_DATAINCOMPLETE
            MsgBox "The data was incomplete at the time of the request. Please try again later!"
        Case DFS_DATAMOREPENDING
        '    DoRequest obj, lTimeOutMilliseconds, True
         MsgBox "Request Data More Pending!"
        Case Else
            ' Determine if timeout occurred
            If (lTimeOutMilliseconds > 0) And (lTimeCount >= lTimeOutMilliseconds) Then
                MsgBox "Request timeout occurred!"
            Else

                MsgBox "Unexpected Error in Request"
            End If
    End Select
End Function


Sub Main()
    Set dataMgr = CreateObject("Dfs.DataManager")
  '  Set price = DfsPrice.DataPrice
    Set price = dataMgr.CreateOb("Price")

   
    'Set the Request Parameters
    price.Security(0) = "ARC"
    price.Exchange(0) = "EWG"
    price.Security(1) = "HUJ"
    price.Exchange(1) = "KYM"
    price.Security(2) = "OTQ"
    price.Exchange(2) = "ZSA"

    
    'Make the request and wait until the data is returned
    iTimout = 20000
    bReqNext = False
    If Not DoRequest(price, iTimeOut, bReqNext) Then WScript.Quit
    
    'Process the data returned
    Dim i
    For i = 0 To price.RowCount - 1
        MsgBox price.Security(i) & price.LastPriceDouble(i) & price.AskFlag(i) & price.AskNumLong(i) & vbCrLf
        MsgBox price.AskPriceDouble(i) & price.AskVolumeDouble(i) & price.BidFlag(i) & price.BidNumLong(i) & BidPriceDouble(i) & vbCrLf

        MsgBox price.BidVolumeDouble(i) & price.CumValueDouble(i) & price.CumVolumeDouble(i) & price.HighPriceDouble(i) & price.LowPriceDouble(i) & vbCrLf
        MsgBox price.MktValueDouble(i) & price.MktVolumeDouble(i) & price.MovementDouble(i) & price.QuoteBasis(i) & price.StatusNotes(i) & vbCrLf
        MsgBox price.ReportCode(i) & price.TradeDate(i) & price.TradeTime(i) & price.UpdateTime(i) & vbCrLf

        MsgBox price.UnadjustedLastPrice(i) & price.Units(i) & price.NumberOfTrades & vbCrLf
    Next
End Sub

Open in new window

0
 
Dushan De SilvaTechnology ArchitectAuthor Commented:
Hi Rob,
Thanks a lot!
I'm really really appreciate you kind help!!!

BR Dushan.
0
 
RobSampsonCommented:
No worries. Glad it worked.

Rob.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 5
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now