PDA

View Full Version : [SOLVED] Including scripts during execution



mynci
09-29-2005, 06:17 AM
Hi, hope this is the right place to ask etc, i haven't been able to find anything after a barrage of google searches, i started to suspect that tis not possible, maybe i was just asking the wrong questions.

Basically i need to be able to alter a module (or other file inlcduding some vb code), replace it on a machine (as in overwrite the file) and have the new functions/modified code execute whenever a function in the module is next called. Basically im after the equivalent of a php include() statement. i appreciate this wouldnt be possible in a compiled vb project, but i wondered if it could be done with vba. i suspect that a command to 'refresh' a mdoule from disk would also server the same purpose. i cant shut down and restart the software to acheive the reload.

hope that makes sense, and that someone could confirm whether or not this is possible.

many thanks
Mynci

mvidas
09-29-2005, 07:54 AM
Hi mynci, welcome to VBAX!
You can alter modules in VBA using extensibility, with which you can add/remove lines, add/remove/import/export modules, just about anything. In some later versions of excel, though, there are warning windows for this as a security measure.

Another thing you could do is have the code located in a text file on the system or a shared server, then load that code from the file using script control. Update the text file, and since the code would be loaded at runtime each time, any changes would be immediately affected next time it was accessed.

I'd be happy to give you examples of either of these, if you want to give me an idea of what you're trying to accomplish and any guidelines you want to stay within. I'd be happy to work with you to get your desired end result. :)

Matt

MOS MASTER
10-06-2005, 02:24 PM
I'd be happy to give you examples of either of these, if you want to give me an idea of what you're trying to accomplish and any guidelines you want to stay within. I'd be happy to work with you to get your desired end result. :)

Matt

Hi Matt & welcome to VBAX Mynci! :hi:

I'd love to see your examples so please go ahead and produce them. :yes

mvidas
10-07-2005, 05:27 AM
Hi Carlos,

To change something within the VBE at runtime, you could either look up a kb entry I have (that I wrote before I knew about the script control, my second example), you could also look at http://pubs.logicalexpressions.com/Pub0009/LPMArticle.asp?ID=307 for some details. Just search google for VBA Extensibility. A fun example is one I wrote for someone a couple days ago, that allows you to change the default printer for windows.. paste this entire thing into a blank module, the ChoosePrinter function is the one with extensibility (creates a userform at runtime, then removes it)


'http://www.experts-exchange.com/Applications/MS_Office/Excel/Q_21584553.html

Option Explicit
Private Declare Function SetDefaultPrinter Lib "winspool.drv" Alias "SetDefaultPrinterA" _
(ByVal pszPrinter As String) As Long
Sub ChangePrinters()
Dim PrnNames(), CurPrn As String, NewPrn As String
GetPrinters PrnNames, CurPrn
NewPrn = ChoosePrinter(PrnNames, CurPrn)
If SetPrinter(NewPrn) = True Then
MsgBox "Printer change successful!"
Else
MsgBox "Printer change unsuccessful"
End If
End Sub

Function SetPrinter(ByVal ThePrinter As String) As Boolean
Dim SetPrinterResult As Long
SetPrinterResult = SetDefaultPrinter(ThePrinter)
If SetPrinterResult = 1 Then SetPrinter = True
End Function

Function ChoosePrinter(InputArray() As Variant, ByVal CurrPrn As String) As String
Dim jUF, i As Long, ArrayUB As Long, ChosenPrinter As String, TempArr, OutputArray
Set jUF = ThisWorkbook.VBProject.VBComponents.Add(3)
ArrayUB = UBound(InputArray)
For i = 0 To ArrayUB
With jUF.Designer.Controls.Add("forms.label.1")
.Caption = InputArray(i)
If InputArray(i) = CurrPrn Then
.Caption = .Caption & " (default)"
End If
.Width = 165
.Height = 20
.Top = i * 20 + 5
.Left = 20
.Name = "lab" & I
End With
With jUF.Designer.Controls.Add("forms.optionbutton.1")
.Left = 5
.Top = i * 20 + 5
.Width = 10
.Height = 10
.Name = "ob" & i
.Caption = ""
End With
Next 'I
With jUF
.Properties("Width") = 200
.Properties("Height") = IIf(ArrayUB < 8, (ArrayUB + 1) * 20 + 60, 200)
.Properties("KeepScrollBarsVisible") = 2
.Properties("ScrollBars") = 2
.Properties("Caption") = "Choose Printer"
.Properties("ScrollHeight") = (ArrayUB + 3) * 20
End With
With jUF.Designer.Controls.Add("forms.commandbutton.1")
.Left = 40
.Height = 20
.Top = (ArrayUB + 1) * 20 + 10
.Width = 100
.Caption = "Submit"
End With
jUF.CodeModule.AddFromString "Private Sub CommandButton1_Click()" & vbCrLf & _
" Dim i As Long, ThePrn As String" & vbCrLf & _
" For i = 0 To (Me.Controls.Count - 1) / 2 - 1" & vbCrLf & _
" If Me.Controls(""ob"" & i).Value = True Then" & vbCrLf & _
" ThePrn = Me.Controls(""lab"" & i).Caption" & vbCrLf & " Exit For" & vbCrLf & _
" End If" & vbCrLf & " Next 'i" & vbCrLf & _
" On Error Resume Next" & vbCrLf & " ActiveWorkbook.Names(""asdfasdfasdf7"").Delete" _
& vbCrLf & " Sheets(1).Names.Add ""asdfasdfasdf7"", ""={"""""" & ThePrn & """"""}""" & _
vbCrLf & " On Error GoTo 0" & vbCrLf & " Unload Me" & vbCrLf & "End Sub"
VBA.UserForms.Add(jUF.Name).Show
ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(jUF.Name)
On Error Resume Next
ChosenPrinter = ActiveWorkbook.Names("asdfasdfasdf7").RefersTo
On Error GoTo 0
If ChosenPrinter <> "" Then
ActiveWorkbook.Names("asdfasdfasdf7").Delete
ChosenPrinter = Mid(ChosenPrinter, InStr(1, ChosenPrinter, "{") + 2)
ChosenPrinter = Left(ChosenPrinter, InStr(1, ChosenPrinter, "}") - 2)
End If
ChoosePrinter = ChosenPrinter
End Function

Function GetPrinters(ByRef PrnNames() As Variant, ByRef CurPrn As String) As Boolean
Dim strComputer As String, objWMIService As Object, colItems As Object
Dim objItem As Object, i As Long
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Printer", , 48)
ReDim PrnNames(0)
For Each objItem In colItems
ReDim Preserve PrnNames(i)
PrnNames(i) = objItem.Name
If objItem.Attributes And 4 Then
CurPrn = objItem.Name
End If
i = i + 1
Next
End Function

Of course you can always ask you have any specific questions about it :)

As for the second idea, I'll not only give you an example of loading code from a file, but other ways of using script control as well:


'These use late binding for script control, you could also just set a reference
' to "Microsoft Script Control x.x", and dim ScriptCont as ScriptControl
'Uses vbscript language while running, which can throw some people off as it
' is a little different than vba (don't dim a variable 'as type', etc)

Option Explicit

Sub Carlos1()
'just executing a statement, or group of statements. Does not need a subroutine
' or function declaration line
Dim ScriptCont As Object, ASnippetOfCode As String, ANum As Long
ANum = 3
ASnippetOfCode = "i=" & ANum & vbLf & "i=i*2" & vbLf & "msgbox i"
Set ScriptCont = CreateObject("msscriptcontrol.scriptcontrol")
ScriptCont.Language = "VBScript" 'could also be jscript, i think
ScriptCont.ExecuteStatement ASnippetOfCode
Set ScriptCont = Nothing
End Sub

Sub Carlos2()
'takes routine from the internet and runs it
Dim ScriptCont As Object, wSite As String, wSiteText As String
Set ScriptCont = CreateObject("msscriptcontrol.scriptcontrol")
wSite = "http://www.hastalavidas.com/mvidascode.txt"
wSiteText = GetWebie=IEsString(wSite)
ScriptCont.Language = "VBScript"
ScriptCont.AddCode wSiteText
ScriptCont.Run "MsgboxHi"
Set ScriptCont = Nothing
End Sub

Function GetWebIE(ByVal vWebSite As String) As String
Dim IE As InternetExplorer
Set IE = CreateObject("internetexplorer.application")
IE.Navigate2 vWebSite
Do While IE.ReadyState <> 4 'READYSTATE_COMPLETE
DoEvents
Loop
GetWebIE = IE.Document.body.innertext 'could also be .innerhtml
Set IE = Nothing
End Function

Sub Carlos3()
'first creates a text file, then loads that file. this also shows how
' you can use arguments if you wanted to
Dim ScriptCont As ScriptControl, vFF As Long, CodeStr As String, DummyFile As String
Dim SampleNum As Double
DummyFile = "C:\alskfjadpori.txt"
vFF = FreeFile
Open DummyFile For Output As #vFF
Print #vFF, "function SquareANumber(byval ANumber)"
Print #vFF, " squareanumber=anumber ^ 2"
Print #vFF, "end function"
Close #vFF
Open DummyFile For Binary As #vFF
CodeStr = Space$(LOF(vFF))
Get #vFF, , CodeStr
Close #vFF
Set ScriptCont = CreateObject("msscriptcontrol.scriptcontrol")
ScriptCont.Language = "vbscript"
SampleNum = 7
ScriptCont.AddCode CodeStr
MsgBox ScriptCont.Run("squareanumber", SampleNum)
Set ScriptCont = Nothing
Kill DummyFile
End Sub

Again, please let me know if you have any questions about this!
Matt

MOS MASTER
10-13-2005, 02:20 PM
Thanx Matt, :hi:

Some of this stuff looks very nice.
And I love using WMI cause it's mucho powerfull.

Wil test out some of this stuff soon...like always I'm a bit to busy at the moment.

Thanx for posting. :yes

mvidas
10-14-2005, 06:14 AM
I'm here if you have any questions :)