Solved

Create executable from vbs

Posted on 2011-02-28
10
599 Views
Last Modified: 2012-05-11
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
Comment
Question by:Dushan De Silva
  • 5
  • 5
10 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 35003712
Hi, in the DoRequest function, change all instances of
DfsCmd.

to
datamgr.

or
obj.

and see what happens.

Regards,

Rob.
0
 
LVL 17

Author Comment

by:Dushan De Silva
ID: 35003730
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 35003755
Hmmmm, try
dataMgr.

again, but also, above this line:
Call Main

add this:
Dim dataMgr

and see what you get.

Regards,

Rob.
0
Resolve Critical IT Incidents Fast

If your data, services or processes become compromised, your organization can suffer damage in just minutes and how fast you communicate during a major IT incident is everything. Learn how to immediately identify incidents & best practices to resolve them quickly and effectively.

 
LVL 17

Author Comment

by:Dushan De Silva
ID: 35003806
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 35003831
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
 
LVL 17

Author Comment

by:Dushan De Silva
ID: 35003965
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
 
LVL 17

Author Comment

by:Dushan De Silva
ID: 35003990
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
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 35004033
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
 
LVL 17

Author Closing Comment

by:Dushan De Silva
ID: 35004074
Hi Rob,
Thanks a lot!
I'm really really appreciate you kind help!!!

BR Dushan.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35004086
No worries. Glad it worked.

Rob.
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

809 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question