Coolhand2120
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.Shel l")
ConfigArray = Split("dbIP,dbDB,dbUID,dbP assword,sS rcTable,ou tputPath", ",")
For x = 0 To UBound(ConfigArray)
execStr = execStr & ConfigArray(x) & " = WshShell.RegRead(""HKCU\So ftware\EPS MMCS\" & 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
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.Shel
ConfigArray = Split("dbIP,dbDB,dbUID,dbP
For x = 0 To UBound(ConfigArray)
execStr = execStr & ConfigArray(x) & " = WshShell.RegRead(""HKCU\So
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
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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).Va lue)
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.R ows = UBound(rsData, 2) + 1
frmSelection.MSFlexGrid1.C ols = 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.C olWidth(i) = 275 + (100 * Len(rsData(i, x)))
maxLen = Len(rsData(i, x))
End If
frmSelection.MSFlexGrid1.T extMatrix( 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.T extMatrix( 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.Shel l")
ConfigArray = Split("dbIP,dbDB,dbUID,dbP assword,sS rcTable,ou tputPath", ",")
For x = 0 To UBound(ConfigArray)
execStr = execStr & ConfigArray(x) & " = WshShell.RegRead(""HKCU\So ftware\EPS MMCS\" & 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.Shel l")
Dim ConfigArray() As String
Dim execStr As String
Dim x As Integer
ConfigArray = Split("dbIP,dbDB,dbUID,dbP assword,sS rcTable,ou tputPath", ",")
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
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).Va
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.R
frmSelection.MSFlexGrid1.C
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.C
maxLen = Len(rsData(i, x))
End If
frmSelection.MSFlexGrid1.T
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.T
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.Shel
ConfigArray = Split("dbIP,dbDB,dbUID,dbP
For x = 0 To UBound(ConfigArray)
execStr = execStr & ConfigArray(x) & " = WshShell.RegRead(""HKCU\So
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.Shel
Dim ConfigArray() As String
Dim execStr As String
Dim x As Integer
ConfigArray = Split("dbIP,dbDB,dbUID,dbP
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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
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
For x = 0 To UBound(ConfigArray)
execStr = execStr & GetSetting("HKCU\Software\
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
ASKER
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).Val ue & " = 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)
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
exec2string = chr(13) & exec2string & adodbRS.Fields.Item(0).Val
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)
ASKER
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.Shel l")
configNArray = Split("dbIP,dbDB,dbUID,dbP assword,sS rcTable,ou tputPath", ",")
For x = 0 To UBound(configNArray)
configArray(x) = WshShell.RegRead("HKCU\Sof tware\EPSM MCS\" & 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
-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.Shel
configNArray = Split("dbIP,dbDB,dbUID,dbP
For x = 0 To UBound(configNArray)
configArray(x) = WshShell.RegRead("HKCU\Sof
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
ASKER
BTW if anyone knows if VBA can use the execute statment or any kind of "string execute" function please do tell.
-Coolhand2120
-Coolhand2120
Store your SQL in a string variable. I call mine strSQL. Then use:
DoCmd.RunSQL strSQL
Bob