I want to launch swf application through vb script code,by making function library in qtp.
Try this sample :
Option Explicit
Dim Application
Application = "D:\Offroad Madness.swf" 'Path to your swf file.Just change this line
Call RunThis(Application)
'*********************************************************************************
Sub RunThis(Application)
Dim Title,Ws,Question,Result
Title = "Open SWF Files by Hackoo 2015"
Set Ws = CreateObject("WScript.Shell")
Question = MsgBox("Did you want to open this file "& DblQuote(Application) &" with iexplore ?" & Vbcr &_
"Yes ==> To open the swf file with iexplore" & Vbcr &_
"No ==> To open the swf file with default program" & Vbcr &_
"Cancel ==> To quit this script",vbQuestion+vbYesNoCancel,Title)
If Question = vbYes Then
Result = Ws.Run("iexplore.exe "& DblQuote(Application),1,False)
End If
If Question = vbNo Then
Result = Ws.Run(DblQuote(Application),1,False)
End If
If Question = vbCancel Then
Wscript.Quit()
End If
End Sub
'*********************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*********************************************************************************
Related
Truth: I am completely new to this scripting thing and have reached an end-pass. I am trying to write a script that will not only create a shortcut on the user's desktop, but when the user clicks on the icon, I want them to be asked if they really want to shut down the computer and given the option to cancel the shutdown or proceed with the shutdown. So far I have searched to the end of my textbook and google. I can achieve creating an icon and having it perform a Windows native shutdown but not with my special intervening actions. I just don't know how to make the icon call back into the script for the select case routine... Sorry if it is a bit messy See below:
result = MsgBox ("Would you really like to Shutdown?", vbYesNo, "Shutdown?")
Set Shell = CreateObject("WScript.Shell")
DesktopPath = Shell.SpecialFolders("Desktop")
' Add Shutdown link to the desktop
Set linkShutdown = Shell.CreateShortcut(DesktopPath & "\Shutdown.lnk")
linkShutdown.Description = "Shutdown the computer"
linkShutdown.IconLocation = ("%SystemRoot%\system32\SHELL32.dll,27")
linkShutdown.TargetPath = "shutdown"
linkShutdown.WindowStyle = 1
linkShutdown.WorkingDirectory = "%windir%"
linkShutdown.Save
Select Case result
Case vbYes
MsgBox("Shutting down ...")
Dim objShell
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 0"
Case vbNo
MsgBox("Ok")
End Select
Try this Vbscript : Ask2Shutdown.vbs
Option Explicit
Dim MyScriptPath
MyScriptPath = WScript.ScriptFullName
Call Shortcut(MyScriptPath,"Shutdown the computer")
Call AskQuestion()
'**********************************************************************************************
Sub Shortcut(PathApplication,Name)
Dim objShell,DesktopPath,objShortCut,MyTab
Set objShell = CreateObject("WScript.Shell")
MyTab = Split(PathApplication,"\")
If Name = "" Then
Name = MyTab(UBound(MyTab))
End if
DesktopPath = objShell.SpecialFolders("Desktop")
Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & Name & ".lnk")
objShortCut.TargetPath = Dblquote(PathApplication)
ObjShortCut.IconLocation = "%SystemRoot%\system32\SHELL32.dll,-28"
objShortCut.Save
End Sub
'**********************************************************************************************
Sub AskQuestion()
Dim Question,Msg,Title
Title = "Shutdown the computer"
Msg = "Are you sure to shutdown the computer now ?"& Vbcr &_
"If yes, then click [YES] button "& Vbcr &_
"If not, then click [NO] button"
Question = MsgBox (Msg,VbYesNo+VbQuestion,Title)
If Question = VbYes then
Call Run_Shutdown(30)
else
WScript.Quit()
End if
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Run_Shutdown(N)
Dim ws,Command,Execution
Set ws = CreateObject("wscript.Shell")
Command = "Cmd /c Shutdown -s -t "& N &" -c "& DblQuote("Save your work because your PC will shut down in "& N &" seconds")
Execution = ws.run(Command,0,True)
End sub
'**********************************************************************************************
Set x = CreateObject("Shell.Application")
x.ShutdownWindows
Gives you the Windows' Shutdown dialog.
You have two scripts in one file that you run sequentally. Put them into two files.
I need to create a shortcut in which I can be prompted if I would like to shut down windows (Action to shutdown when clicking ok). Any ideas?
So far the working shutdown shortcut that I have does not issue the prompt a message asking if I truly want to shutdown or cancel the shortcut request.
Here it is:
Dim shellApp, answer
'Creates Shortcut with a Path to the desktop.
Set Shell = CreateObject("WScript.Shell")
DesktopPath = Shell.SpecialFolders("Desktop")
'Establishes and names the shortcut "Shutdown".
Set linkShutdown = Shell.CreateShortcut(DesktopPath & "\Shutdown.lnk")
'Adds shutdown code to the shortcut.
linkShutdown.Arguments = "-s -t 01"
'Adds Description to shortcut that displays message on link over.
linkShutdown.Description = "Shutdown this Computer"
'Creates Icon for shortcut using system shutdown icon.
linkShutdown.IconLocation = ("%SystemRoot%\system32\SHELL32.dll,27")
'Retrieves shutdown target path for shortcut.
linkShutdown.TargetPath = "shutdown"
'Saves the Script.
linkShutdown.Save
'Prompts the user if they want to shutdown their computer,
'displays ok and cancel buttons for the user to choose.
Set shellApp = CreateObject("Shell.Application")
answer = MsgBox("Do you really want to shut down the computer?", 1, _
"Turn off Computer Script!")
If answer = 1 then
Initiate_Logoff()
End if
'Function that shuts computer down.
Function Initiate_Logoff()
'Adds shutdown code to the shortcut.
End Function
Try this code :
Option Explicit
Dim MyScriptPath
MyScriptPath = WScript.ScriptFullName
Call Shortcut(MyScriptPath,"Shutdown the computer")
Call AskQuestion()
'**********************************************************************************************
Sub Shortcut(PathApplication,Name)
Dim objShell,DesktopPath,objShortCut,MyTab
Set objShell = CreateObject("WScript.Shell")
MyTab = Split(PathApplication,"\")
If Name = "" Then
Name = MyTab(UBound(MyTab))
End if
DesktopPath = objShell.SpecialFolders("Desktop")
Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & Name & ".lnk")
objShortCut.TargetPath = Dblquote(PathApplication)
ObjShortCut.IconLocation = "%SystemRoot%\system32\SHELL32.dll,-28"
objShortCut.Save
End Sub
'**********************************************************************************************
Sub AskQuestion()
Dim Question,Msg,Title
Title = "Shutdown the computer"
Msg = "Are you sure to shutdown the computer now ?"& Vbcr &_
"If yes, then click [YES] button "& Vbcr &_
"If not, then click [NO] button"
Question = MsgBox (Msg,VbYesNo+VbQuestion,Title)
If Question = VbYes then
Call Run_Shutdown(30)
else
WScript.Quit()
End if
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Run_Shutdown(N)
Dim ws,Command,Execution
Set ws = CreateObject("wscript.Shell")
Command = "Cmd /c Shutdown -s -t "& N &" -c "& DblQuote("Save your work because your PC will shut down in "& N &" seconds")
Execution = ws.run(Command,0,True)
End sub
'**********************************************************************************************
This is my first post, but I have been programming for a long time now
I just want to ask a quick question and the title explains it all. I want my VBS to run a file, but I dont want it to search just for a specific directory, I want it to just find the file if you know what I mean, because if I gave the script to anyone else, this file could be ANYWHERE on their computer.
This is the current couple of important lines that I am using for running files:
set wshshell = wscript.CreateObject("wscript.shell")
and
wshshell.run <program directory here>
You need a recursive function like this one searching for shortcuts.
Sub GenerateHotkeyInFolder(Fldr)
on error resume next
set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set FldrItems=Fldr.Items
For Each oFile in FldrItems
With oFile
If .IsFileSystem = true And .IsLink = true And .Type <> "Shortcut to MS-DOS Program" then
set lnk = WshShell.CreateShortcut(oFile.Path)
If lnk.hotkey <> "" then
Set fsop = fso.GetFile(.Path)
LnkName = "<b>" & fso.GetBaseName(fso.GetFile(.Path)) & "</b><br>" & fsop.ParentFolder.path & "\" & fso.GetBaseName(fso.GetFile(.Path)) & "." & fso.GetExtensionName(fso.GetFile(.Path))
TableVar = TableVar & "<tr><td><b>" & lnk.hotkey & "</b></td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & lnk.fullname & Chr(34) & ")'>" & lnkname & "</a>" & "</td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & lnk.targetpath & Chr(34) & ")'>" & lnk.targetpath & "</a></td></tr>" & vbcrlf
End If
ElseIf .IsFileSystem = true And .IsFolder = true then
GenerateHotkeyInFolder(.GetFolder)
End If
End With
Next
End Sub
I need some excel vba examples, where with in the VBA code(Excel Macro) i could call a VBScript and will get some values like filename and directory information from the vbscript and assign it to the variables in VBA code.
Thank you in advance
Some thing like this
VBA macro:
Sub Foo2Script
Dim x As Long
x=2
'Call VBscript here
MsgBox scriptresult
End Sub
VBScript:
Dim x, y ,Z
x = x_from_macro
y = x + 2
Z = X+Y
scriptresult = y,Z
It can be done but I would have to agree with Tomalak and others that it's not the best way to go. However, saying that, VBScript can work wonders occasionally if you use it as a kind of fire and forget mechanism. It can be used quite effectively to simulate multi-threading in VBA whereby you breakdown the payload and farm it out to individual VBScripts to run independently. Eg you could arrange a "swarm" of individual VBScripts to mass download from websites in the background whilst VBA continues with other code.
Below is some VBA code I've simplified to show what can be done and writes a simple VBScript on the fly. Normally I prefer to run it using 'wshShell.Run """" & SFilename & """" which means I can forget about it but I've included in this example this method Set proc = wshShell.exec(strexec) which allows a test of the object for completion
Put this in MODULE1
Option Explicit
Public path As String
Sub writeVBScript()
Dim s As String, SFilename As String
Dim intFileNum As Integer, wshShell As Object, proc As Object
Dim test1 As String
Dim test2 As String
test1 = "VBScriptMsg - Test1 is this variable"
test2 = "VBScriptMsg - Test2 is that variable"
'write VBScript (Writes to Excel Sheet1!A1 & Calls Function Module1.ReturnVBScript)
s = s & "Set objExcel = GetObject( , ""Excel.Application"") " & vbCrLf
s = s & "Set objWorkbook = objExcel.Workbooks(""" & ThisWorkbook.Name & """)" & vbCrLf
s = s & "Set oShell = CreateObject(""WScript.Shell"")" & vbCrLf
s = s & "Msgbox (""" & test1 & """)" & vbCrLf
s = s & "Msgbox (""" & test2 & """)" & vbCrLf
s = s & "Set oFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
s = s & "oShell.CurrentDirectory = oFSO.GetParentFolderName(Wscript.ScriptFullName)" & vbCrLf
s = s & "objWorkbook.sheets(""Sheet1"").Range(""" & "A1" & """) = oShell.CurrentDirectory" & vbCrLf
s = s & "Set objWMI = objWorkbook.Application.Run(""Module1.ReturnVBScript"", """" & oShell.CurrentDirectory & """") " & vbCrLf
s = s & "msgbox(""VBScriptMsg - "" & oShell.CurrentDirectory)" & vbCrLf
Debug.Print s
' Write VBScript file to disk
SFilename = ActiveWorkbook.path & "\TestVBScript.vbs"
intFileNum = FreeFile
Open SFilename For Output As intFileNum
Print #intFileNum, s
Close intFileNum
DoEvents
' Run VBScript file
Set wshShell = CreateObject("Wscript.Shell")
Set proc = wshShell.exec("cscript " & SFilename & "") ' run VBScript
'could also send some variable
'Set proc = wsh.Exec("cscript VBScript.vbs var1 var2") 'run VBScript passing variables
'Wait for script to end
Do While proc.Status = 0
DoEvents
Loop
MsgBox ("This is in Excel: " & Sheet1.Range("A1"))
MsgBox ("This passed from VBScript: " & path)
'wshShell.Run """" & SFilename & """"
Kill ActiveWorkbook.path & "\TestVBScript.vbs"
End Sub
Public Function ReturnVBScript(strText As String)
path = strText
End Function
This demonstrated several ways that variables can be passed around.
Manually we right click on a file and select the "open with" option to open in other format.
Now i need to do this through vbscript
To open a file using a specific application, use the WshShell.Run methood to run that application and pass the file name as a parameter.
Here's an example that opens the same text file in Notepad, Internet Explorer and Microsoft Word:
strFileName = "c:\myfile.txt"
Set oShell = CreateObject("WScript.Shell")
oShell.Run "notepad " & strFileName
oShell.Run "iexplore " & strFileName
oShell.Run "winword " & strFileName
Note that if the file name includes spaces, you need to enslose it in quotes, like this:
oShell.Run "winword ""c:\my file.txt"""
If you want to create an association script with VBScript, for example when you write click on a file and open it with certain program, you can use this script I had created way back:
'Run Script
InsertContextMenu
Sub InsertContextMenu ()
Dim sText
Dim sExePath
'For executable-only context menu, the key should be created here
'HKEY_CLASSES_ROOT\exefile\shell
sText = InputBox ("Enter the Text for the context menu." & vbNewLine & vbNewLine & "Example" & vbNewLine & "Open with Notepad")
If Len(Trim(sText)) > 0 Then
sExePath = InputBox ("Enter the path of the executable file for the context menu." & vbNewLine & vbNewLine & "Example" & vbNewLine & "C:\Windows\Notepad.exe")
If Len(Trim(sExePath)) > 0 Then
Set SHL = CreateObject ("WScript.Shell")
SHL.RegWrite "HKCR\*\Shell\" & sText & "\",sText
SHL.RegWrite "HKCR\*\Shell\" & sText & "\Command\", sExePath & " %1"
If Len(SHL.RegRead ("HKCR\*\Shell\" & sText & "\Command\")) > 0 Then
MsgBox "The Context Menu successfully created !.",vbInformation
Else
MsgBox "An unknown error has occured !!",vbCritical
End If
End If
End If
Set SHL = Nothing
End Sub
Just copy above code, and paste into a file and give that file .vbs extension.