Link to home
Start Free TrialLog in
Avatar of Coolhand2120
Coolhand2120Flag for United States of America

asked on

VBS vs VBA execute statment.

Does VBA6 support any form of the VBS execute statment?

I want to compile a string variant of VBA commands seperated by : and execute them in VBA.

Like this:

Function readConfig() As Boolean
    On Error GoTo errorhandler
    Dim ConfigArray() As String
    Dim WshShell
    Dim execStr As String
    Dim x As Integer
   
    Set WshShell = CreateObject("WScript.Shell")
   
    ConfigArray = Split("dbIP,dbDB,dbUID,dbPassword,sSrcTable,outputPath", ",")
   
    For x = 0 To UBound(ConfigArray)
    execStr = execStr & ConfigArray(x) & " = WshShell.RegRead(""HKCU\Software\EPSMMCS\" & ConfigArray(x) & """):"
    Next
   
    Execute execStr

    dbDriver = "Driver={SQL Server};Server=" & dbIP & ";Database=" & dbDB & ";UID=" & dbUID & ";PWD=" & dbPassword & ";"

    If testConnection = False Then GoTo errorhandler
   
    readConfig = True
    Set WshShell = Nothing
    Exit Function
   
errorhandler:
    readConfig = False
    MsgBox "There was an error reading the regestry.", vbOKOnly, "Missing Values"
End Function

Thanks for the help!

-Coolhand2120
Avatar of Bob Lamberson
Bob Lamberson
Flag of United States of America image

I believe you can use the semicolon ;   Have you tested it?

Bob
Avatar of Coolhand2120

ASKER

Ya sorry I didn't mention, I tested the code and VBA stuido 6 says:

Highlights execute in the code and says "Sub or variable not defined".  Funny thing is it capitlizes execute like it recognized it, still dosen't work, maybe I need another refrence?

-Coolhand2120
SOLUTION
Avatar of EDDYKT
EDDYKT
Flag of Canada image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
The array I'm using is quite small and ubound(array) should return no higher an integer than the top of the array.  Also I'm not getting an out of bounds error.

It won't even run as I have option explicit turned on and it thinks 'execute' is a variant.  I'm just about to give up, I use this technique in VBS for ASP all the time.

-Coolhand2120
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I'm sorry I should have stated what I was trying to do.  I'm working in VBA not VBscript.  I'm trying to assign regestry values to VBA vars, I don't want to type out all the vars though.  I suppose I could enumerate the vars in some kind of config array but if I can do it by somehow turning the var value into a VBA variant.  I'm starting to think this isn't possible because VBA is a compiled language not a scripted language. It's just hard to remember parts of the config array without creating a user type or class and that a little more overhead than I wanted, but may be the only way to go.  So you can see more of the story here is the main module I'm working on right now.  The vars are in the declaration section, the part I posted earlier is for reading the regestry.

I'm open to any method of doing this, my background is in scripted languages so I'm used to using strings a lot.

Thanks for the help!

-Coolhand2120

Option Explicit
Public dbDriver As String
Public outputPath As String
Public cn As New ADODB.Connection
Public rs As Recordset
Public rsData()
Public colArray()
Public rsSelection()
Public dbDB As String
Public sSrcTable As String
Public dbUID
Public dbPassword
Public dbIP

Public Function fillCombo(targetCombo As VB.ComboBox, srcQuery As String, cnX As ADODB.Connection, Optional selData As String)
'On Error GoTo errorhandler
Dim rsX As ADODB.Recordset
targetCombo.Clear
If selData <> "" Then
targetCombo.Text = Trim(selData)
End If
    Set rsX = cnX.Execute(srcQuery)
    Do Until rsX.EOF Or rsX.BOF
   
            targetCombo.AddItem Trim(rsX.Fields.Item(0).Value)
       
        rsX.MoveNext
    Loop
    rsX.Close
    Set rsX = Nothing
Exit Function
errorhandler:
MsgBox "There was an error while filling a combo box, here is the query: " & vbCrLf & srcQuery, vbCritical, "Critical Error"
End Function


Public Function cbit(boolval As Boolean) As Integer
If boolval = True Then
    cbit = 1
Else
    cbit = 0
End If
End Function

Sub init()

'Create SQL database connection and logon to master database
If readConfig = False Then
frmSetup.Show
frmSetup.SetFocus
End If



End Sub
Sub getData()

On Error GoTo errorhandler
    Dim i As Integer
    Dim x As Integer
    Dim sysTableID As String
    Dim maxLen As Long
   
    'Find out the table ID
    Set rs = cn.Execute("select id from [" & frmSetup.dataBase & "]..sysobjects where name = '" & frmSetup.srcTable & "';")
    sysTableID = rs.Fields.Item(0)
    rs.Close
    Set rs = Nothing
   
    'Fill the flex grid with data
    Set rs = cn.Execute("select * from [" & frmSetup.dataBase & "].." & frmSetup.srcTable & ";")
    rsData = rs.GetRows
    frmSelection.MSFlexGrid1.Rows = UBound(rsData, 2) + 1
    frmSelection.MSFlexGrid1.Cols = UBound(rsData, 1) + 1
    For i = 0 To UBound(rsData, 1)
    maxLen = 0
       For x = 1 To UBound(rsData, 2)
            If rsData(i, x) <> "" Then
               
               
                If Len(rsData(i, x)) > maxLen Then
           
                frmSelection.MSFlexGrid1.ColWidth(i) = 275 + (100 * Len(rsData(i, x)))
               
                maxLen = Len(rsData(i, x))
               
                End If
               
               
                frmSelection.MSFlexGrid1.TextMatrix(x, i) = rsData(i, x)
            End If
       Next
    Next
    rs.Close
    Set rs = Nothing
   
    'Find out the column names and put them in the flexgrid
    Set rs = cn.Execute("select name from " & frmSetup.dataBase & ".dbo.syscolumns where id = '" & sysTableID & "' order by colorder;")
    x = 0
    Do Until rs.EOF Or rs.BOF
        frmSelection.MSFlexGrid1.TextMatrix(0, x) = rs.Fields.Item(0)
        x = x + 1
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    Exit Sub
errorhandler:
    MsgBox "There was an error while filling the grid, check your configuration and/or network connection", vbCritical, "Critical Error"
   
End Sub

Sub cleanup()

    If cn.State = 1 Then
        cn.Close
    End If
   
    Unload frmSelection
    Unload frmTemplate
    Unload frmOverview
    Unload frmSetup
    Unload frmAbout
   
End Sub

Function readConfig() As Boolean
    On Error GoTo errorhandler
    Dim ConfigArray() As String
    Dim WshShell
    Dim execStr As String
    Dim x As Integer
    Dim Execute
    Set WshShell = CreateObject("WScript.Shell")
   
    ConfigArray = Split("dbIP,dbDB,dbUID,dbPassword,sSrcTable,outputPath", ",")
   
    For x = 0 To UBound(ConfigArray)
    execStr = execStr & ConfigArray(x) & " = WshShell.RegRead(""HKCU\Software\EPSMMCS\" & ConfigArray(x) & """):"
    Next
    MsgBox execStr


    dbDriver = "Driver={SQL Server};Server=" & dbIP & ";Database=" & dbDB & ";UID=" & dbUID & ";PWD=" & dbPassword & ";"

    If testConnection = False Then GoTo errorhandler
   
    readConfig = True
    Set WshShell = Nothing
    Exit Function
   
errorhandler:
    readConfig = False
    MsgBox "There was an error reading to the regestry.", vbOKOnly, "Missing Values"
End Function
Sub writeConfig()

On Error GoTo errorhandler
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")

Dim ConfigArray() As String
Dim execStr As String
Dim x As Integer

ConfigArray = Split("dbIP,dbDB,dbUID,dbPassword,sSrcTable,outputPath", ",")

dbIP = frmSetup.serverName.Text
dbDB = frmSetup.dataBase.Text
dbUID = frmSetup.loginName.Text
dbPassword = frmSetup.passWord.Text
sSrcTable = frmSetup.srcTable.Text
outputPath = frmSetup.outputPath


For x = 0 To UBound(ConfigArray)
execStr = execStr & ConfigArray(x) & " = frmSetup." & ConfigArray(x) & ".Text:"
Next

For x = 0 To UBound(ConfigArray)
execStr = execStr & "WshShell.regwrite ""HKCU\Software\EPSMMCS\" & ConfigArray(x) & """," & ConfigArray(x) & """, ""REG_SZ"":"
Next

Execute execStr

testConnection

frmSetup.loadCombos


Set WshShell = Nothing
Exit Sub
errorhandler:
MsgBox "There was an error writing to the regestry.", vbOKOnly, "Access Denied or Write Error"
End Sub
Function testConnection() As Boolean
On Error GoTo errorhandler

    If cn.State = 1 Then
        cn.Close
    End If

    If cn.State = 0 Then
        cn.Open dbDriver
    End If

    If cn.State = 1 Then
        testConnection = True
    Else
        testConnection = False
    End If
   
Exit Function
errorhandler:
testConnection = False
End Function
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks Bob thats usefull, but I need to know how to automate assigning vars from the regestry to like named vars in VBA, but I think now it's impossible becaues I can't execute strings in VBA like you can in VBS, so all the vars have to be written out, or I must use an array called config() or somthing so I can enumerate it.

My probelm is that Execute dosen't work, I can get to the regestry settings just fine.

-Coolhand2120
I'm no sure you are understanding my code. The posting of

For x = 0 To UBound(ConfigArray)
      execStr = execStr & GetSetting("HKCU\Software\EPSMMCS\'" & ConfigArray(x) & "'"
Next

does return a value for GetSetting and the experssion adds that value to the execStr. when the for ..next loop is finished the variable execStr contains the values from the registry that correspond to the variables in ConfigArray(x), all in a string. Isn't that what you are after?

Bob
Your solution is great, but one probelm, you I can't use the execute statement.  Thats why I'm stuck.  I think I'll use a similar idea, but without using a string.  Here is an example of some eariler code I made for VBS in ASP.  It uses the execute statement to set some vars from a sql database.  Once again though, I'm using VBA (Visual basic for applications) not VBS and I can't get the execute() statement at the bottom to work in VBA.  

Thanks for the help though!

-Coolhand2120

set adodbRS = cn.Execute("select elementname from controls;")
execstring = "set adodbRS = cn.Execute(""select "
i = 0
comma1 = false
do until adodbRS.BOF or adodbRS.EOF
      if comma1 = false then
            comma1 = true
            comma = ""
      else
            comma = ","
      end if
      execstring = execstring & comma & trim(adodbRS.Fields.Item(0).Value)
      exec2string = chr(13) & exec2string & adodbRS.Fields.Item(0).Value & " = adodbRS.Fields.Item(" & i & ").Value" & chr(13)
      adodbRS.movenext
      i=i+1
loop
execstring = execstring & " " & stylequery & """)" & chr(13) & exec2string & chr(13) & "adodbRS.Close()" & chr(13) & "set adodbRS = nothing" & chr(13)
adodbRS.close()
set adodbRS = nothing
execute(execstring)
This is what I'm going to use, same as the string, but rather than feed to diffrent named vars I feed to a single array called configArray, I put the configNArray local to the function so if I need to add or remove vars from the regestry I can just add or remove from the split function.   Thanks for the support all.

-Coolhand2120

Function readConfig() As Boolean
    On Error GoTo errorhandler
    Dim configNArray() As String
    Dim WshShell
    Dim execStr As String
    Dim x As Integer
    Dim Execute
    Set WshShell = CreateObject("WScript.Shell")
   
    configNArray = Split("dbIP,dbDB,dbUID,dbPassword,sSrcTable,outputPath", ",")
   
    For x = 0 To UBound(configNArray)
    configArray(x) = WshShell.RegRead("HKCU\Software\EPSMMCS\" & configNArray(x))
    Next

    dbDriver = "Driver={SQL Server};Server=" & configArray(0) & ";Database=" & configArray(1) & ";UID=" & configArray(2) & ";PWD=" & configArray(3) & ";"

    If testConnection = False Then GoTo errorhandler
   
    readConfig = True
    Set WshShell = Nothing
    Exit Function
   
errorhandler:
    readConfig = False
    MsgBox "There was an error reading to the regestry.", vbOKOnly, "Missing Values"
End Function
BTW if anyone knows if VBA can use the execute statment or any kind of "string execute" function please do tell.

-Coolhand2120
Avatar of Pete_B
Pete_B


Store your SQL in a string variable. I call mine strSQL. Then use:
DoCmd.RunSQL strSQL