Solved

Calling function by a variable name

Posted on 2010-08-15
11
327 Views
Last Modified: 2012-05-10
I am trying to call a function by its variable name. I have tried the evaluate and application.run method but none of them work. In the code below, I have a Select Case function which calls the CommandCode to run. command is a function name and argument is the value passed into the function. Can someone please give me some advise? Thanks.

Function CommandCode(progctr As Long)
    Dim command As String
    Dim argument As String
   
    command = Worksheets("GUI").Cells(progctr + 1, 2).Value
    argument = Worksheets("GUI").Cells(progctr + 1, 3).Value
   
    Call command(argument)
     
End Function


Private Sub optionStatus(ByVal progctr As Long)

    Select Case progctr
        Case 1            
            Call CommandCode(progctr)
       
        Case Else
            Debug.Print "No match"
    End Select
End Sub
0
Comment
Question by:teeling
  • 5
  • 3
  • 2
  • +1
11 Comments
 
LVL 53

Expert Comment

by:Dhaest
ID: 33443693
0
 

Author Comment

by:teeling
ID: 33443719
CallByName(object, procname, calltype [, args()])

I don't understand what to put in the object part. I am new to VBA. Thanks for the help.
0
 
LVL 53

Expert Comment

by:Dhaest
ID: 33443734
Alternative, if you are using vba:
Application.Run "YourString"
0
 
LVL 53

Expert Comment

by:Dhaest
ID: 33443736
How to Call Functions by Using a String Variable
http://support.microsoft.com/kb/210511
0
 
LVL 58

Expert Comment

by:cyberkiwi
ID: 33443814
I don't think you can call built in functions like MsgBox like that, but custom Macros can be called using Application.Run

Place the code below into a module, and run testCustomMacro.
Put "customMsgBox" into B4 and "hello world" into B3
Sub customMsgBox(ByVal themessage As String)

    MsgBox themessage

End Sub



Sub testCustomMacro()

    Dim command As String

    Dim argument As String

   

    command = Worksheets("GUI").Cells(4, 2).Value

    argument = Worksheets("GUI").Cells(3, 2).Value

   

    Application.Run command, argument

End Sub

Open in new window

0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
LVL 33

Expert Comment

by:Norie
ID: 33445587
Why do you want to 'call' a function?

In VBA functions are normally used to return values not carry out actions.
0
 

Author Comment

by:teeling
ID: 33460612
Dhaest: That didn't work in my case.

cyberkiwi: I've tried your code and it works. Can it be put in the userform instead of module? Thanks.

imnorie: This program that I'm writing connects to the DB via Winsock. Please refer to the image attached. The reason for doing this is to ease the use of this program for other people in the future. So that they won't have to get into VBA to modify a code. They just have to change it through the Excel sheet.
excel-page.JPG
0
 
LVL 58

Expert Comment

by:cyberkiwi
ID: 33460668
> cyberkiwi: I've tried your code and it works. Can it be put in the userform instead of module? Thanks.

No it must be in a module because the function to be called must be globally recognizable.
0
 

Author Comment

by:teeling
ID: 33460853
Here is my problem.

Function MySend(ByVal data As String)
    wsTCP.SendData data
End Function

I cannot declare the winsock twice in the application. Is there any way to get around this?
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim sPage, netName, netPass, coSelect, mfgPass, valpart As String
Dim ctr, ctr2, cstatus As Long
Dim WithEvents wsTCP As OSWINSCK.WINSOCK
Dim sBuffer As String
Dim ScreenBuffer As String
Dim ScreenArr(1 To 25, 1 To 80) As String
Dim RowNo As Integer
Dim ColNo As Integer
Dim ctr5, ctr9, counter, counter5 As Long
Dim CurrentCharacter As String
Dim NextCharacter As String
Dim CurrentString As String
Dim RestofString As String
Dim Colour As Long
Dim ts As String
Dim found, CurPos, CharPos As Boolean
Dim intCount, intIndex As Integer
Dim condition, str As String
Dim progctr, progctrfinal As Long

Private Sub cmdLogin_Click()
    If OptionButton2.Value Then
        Debug.Print "Stop"
        Exit Sub
    End If
    
    If Restart.Value Then Call optionStatus(1)
    
    If Run.Value Then
        progctrfinal = TextBox1.Value
        For progctr = 1 To progctrfinal Step 1
            Call optionStatus(progctr)
        Next progctr
    End If
End Sub

Function CommandCode(PC As Long)
    Dim command As String
    Dim argPassedIn As String
    
    Debug.Print progctr
    command = Worksheets("GUI").Cells(PC + 1, 2).Value
    argPassedIn = Worksheets("GUI").Cells(PC + 1, 3).Value
    Debug.Print command & " " & (argPassedIn)
    
    Application.Run command, argPassedIn
 
End Function

Function MySend(ByVal data As String)
    wsTCP.SendData data
End Function

Private Sub optionStatus(ByVal progctr As Long)
    currentWOSelected = 10060080

    Select Case progctr
        Case 1
            Debug.Print "Logging in"
            
            Login
            Call WaitCurs(20, 51)
            If Not CurPos Then Exit Sub
   
        Case 2

            Debug.Print "Hello too " & progctr
            Call CommandCode(progctr)
            Debug.Print "16.10"
            
        Case 3

            Debug.Print "Hello three " & progctr
            CommandCode progctr
            Call WaitCurs(3, 15)
            If Not CurPos Then Exit Sub
        
        Case 4
            Debug.Print "Case 4"
            CommandCode progctr
            
        Case 5
            Debug.Print "Case 5"
            CommandCode progctr
        
        Case Else
            Debug.Print "No match"
            'Code for any nonmatch
    End Select
End Sub

Private Sub Login()
    On Error GoTo ErrHandler
    Dim sServer As String
    Dim nPort As Long
    ctr = 1
    ctr2 = 1
    cstatus = 1
    
    'username and password from excel "passwords" worksheet
    netName = Worksheets("Passwords").Cells(1, 2).Value               'Network name
    netPass = Worksheets("Passwords").Cells(2, 2).Value               'Network password
    coSelect = Trim(Worksheets("Passwords").Cells(3, 2).Value)        'Company selection
    mfgPass = Worksheets("Passwords").Cells(4, 2).Value               'MFG Pro Password

    ActiveWorkbook.Names.Add Name:="Screen", RefersTo:="=Terminal!A1:cb25"    'Defines "Screen" as a selection of the terminal spreadsheet
    'Create Winsock object for mfgpro access via telnet (hence port 23)
    nPort = 23
    sServer = "erpwebsvr.blah.com"
    Set wsTCP = CreateObject("OSWINSCK.Winsock")   
    wsTCP.connect sServer, nPort
    Exit Sub
    
ErrHandler:
        MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub

Private Sub wsTCP_OnConnect()
    Debug.Print "Connecting"
    MySend (netName & Chr(13))
    MySend (netPass & Chr(13))
    MySend ("." & Chr(13))
    MySend (coSelect & Chr(13))

End Sub

Private Sub wsTCP_OnDataArrival(ByVal bytesTotal As Long)
    ctr = ctr + 1
    wsTCP.GetData sBuffer
    ts = ts + sBuffer
    ts = Right(ts, 4000)
    sPage = sBuffer
    Worksheets("Audit Trail").Cells(ctr, 1).Value = sBuffer
    
    If cstatus = 1 Then
        'Check if ready for password
        'Check that ts contains required text. If > 0 then ts does contain string
        If InStr(ts, "Enter data or press F4 to end.") > 0 Then
            MySend (netName & Chr(13))
            MySend (mfgPass & Chr(13))
            cstatus = 2
            ctr2 = ctr
            Debug.Print "Connected to MFGPRO"
        End If
        ctr2 = ctr

    End If
    
    If cstatus = 2 Then
        If InStr(ts, "to continue") > 0 Then
        MySend (Chr(30)) 'Spacebar Key
        cstatus = 3
        Debug.Print "At main menu"

        End If
    End If
        
    If ctr > ctr2 + 1 Then
        Range("Screen").Interior.Color = 65355 
        Call terminal
    End If
End Sub

Function WaitCurs(Row As Integer, Col As Integer)
    ctr9 = 1
    Do Until ctr9 = 800000
                DoEvents
        If RowNo = Row And ColNo = Col Then
            CurPos = True
            Exit Do
        Else
            If ctr5 > 799000 Then
            CurPos = False
            End If
        End If
        ctr9 = ctr9 + 1
    Loop
End Function

Sub terminal()
'Comment out codes. Too long.
End sub

Open in new window

0
 

Author Comment

by:teeling
ID: 33460890
I got this error when trying to run the codes.

Run-time error '1004':Cannot run the macro 'MySend'. The macro may not be available in this workbook or all macros may be disabled.
0
 

Accepted Solution

by:
teeling earned 0 total points
ID: 33471281
I got this working.

CallByName Me, command, VbMethod, argPassedIn
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

As with any other System Center product, the installation for the Authoring Tool can be quite a pain sometimes. This article serves to help you avoid making these mistakes and hopefully save you a ton of time on troubleshooting :)  Step 1: Make sur…
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…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

746 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now