I currently have a script that takes a PC name and then outputs the IP Address and then another textbox with the Fully Qualified Domain Name. I have been using the InputBox instead of Msgbox as I need to be able to copy the results to the clipboard.
My question is: Is there a way to output both the IP and the FQDN in the same textbox and have a 'Copy to Clipboard' button next to each of those?
Here is what I've been using so far:
Sub Ping
Set objShell = CreateObject("WScript.Shell")
Dim tmp
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Message = "Enter the Computer Name you would like to convert to an IP address."
Host_Names=InputBox(message)
wmiQuery = "Select * From Win32_PingStatus Where " & _
"Address = '" & Host_Names & "'"
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set objPing = objWMIService.ExecQuery(wmiQuery)
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
Msgbox Host_Names & " is Unreachable!"
Exit Sub
Else
tmp = InputBox("The IP Address is:",,objStatus.ProtocolAddress)
tmp = objStatus.ProtocolAddress
End If
Next
strIP = tmp
if strIP = "" then
Exit Sub
end if
Set objScriptExec = objShell.Exec("ping.exe -n 1 -a " & strIP)
strPingResult = objScriptExec.StdOut.ReadAll
Set objStdOut = objScriptExec.StdOut
strNoPing = "Request timed out."
arrayPingResult = split(strPingResult, vbcrlf)
strCheck = strComp(arrayPingResult(3), strNoPing, 1)
if strCheck = 1 then
Msgbox "PC not on the network. Quitting Program"
Exit Sub
else
arrayPCLine = split(arrayPingResult(1), " ")
tmp = InputBox("The fully qualified name is:",,arrayPCLine(1))
end if
End Sub
Thanks for any help you can give me.
The 'natural' GUI for VBScript is .HTA. As in:
<html>
<head>
<title>ClipBoard Demo</title>
<hta:application
id="demo"
></hta>
<script type="text/vbscript">
Option Explicit
Sub Window_OnLoad()
document.GetElementById("teIP").value = "1.2.3.4"
document.GetElementById("teNA").value = "HAL"
End Sub
Sub clpME(sTXT)
' MsgBox document.GetElementById(sTXT).value
window.clipboardData.setData "text", document.GetElementById(sTXT).value
End Sub
</script>
</head>
<body>
<form>
<input type="text" id="teIP">
<input type="button" onclick='clpME "teIP"' value="clp">
<br />
<input type="text" id="teNA">
<input type="button" onclick='clpME "teNA"' value="clp">
</form>
</body>
</html>
(More elaborate example, start here)
I'm not going to pretend this is pretty, but if you're looking for a quick and dirty solution, you can hijack the built-in buttons. I have seen this done before:
Dim msgboxResponse
msgboxResponse = MsgBox("Press: " & vbCrLf _
& "Yes to copy IP address" & vbCrLf _
& "No to copy FQDN" & vbCrLf _
& "Cancel to copy nothing", vbYesNoCancel)
Select Case msgboxResponse
Case vbYes: 'Code to copy IP to clipboard
Case vbNo: 'Code to copy FQDN
Case vbCancel: 'do nothing
Behold UX heaven:
End Select
While not evident, you can copy the content of any msgbox to clipboard just by pressing Ctrl-Ins, but the title and the buttons are also included.
You can just place the data in the clipboard using the clip.exe command line utility.
With WScript.CreateObject("WScript.Shell")
.Environment("PROCESS")("_toClip") = "Here, concatenate the variables to place in clipboard"
.Run "cmd /v /q /c ""echo(!_toClip!|clip""", 0, True
.Environment("PROCESS").Remove "_toClip"
End With
And, of course, instead of showing the two inputboxes, just concatenate the data and then show only one input box with all the required information.
Related
I am trying to implement a recursive search script with following usecase:-
User can input string and directory to search for.
Script will list all the files with path that matches point 1 (maybe in separate file).
I tried it with batch script and tried to run from html page to pass parameters (string and directory). It failed as mentioned over stackoverflow (due to javascripts inability to access file system.)
My batch script is :- findstr /s /i /n /C:#name= *.* v > results.txt
Now I am wondering if my requirement can be fulfilled with batch file or I need to switch to vbscript. Please suggest.
I have no Idea of vbscript.
I can not install any third party tool on my windows workstation.
This is vbscript and won't trigger security dialogs if run from a local page.
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Dirname = InputBox("Enter Dir name")
Searchterm = Inputbox("Enter search term")
ProcessFolder DirName
Sub ProcessFolder(FolderPath)
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
Set contents = thing.OpenAsTextStream
If Instr(contents.readall, searchterm) then wscript.echo thing.path
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
' wscript.echo thing.name
ProcessFolder thing.path
Next
End Sub
EDIT and EDIT2 (add browse for folder)
In an HTA (I had to start from scratch - I couldn't make your butchering of my script work).
<HTML>
<HEAD><TITLE>Simple Validation</TITLE>
<SCRIPT LANGUAGE="VBScript">
Dim Dirname
Dim Searchterm
Dim FSO
Dim objOutFile
Sub Browse
On Error Resume Next
Set bffShell = CreateObject("Shell.Application")
Set bff = bffShell.BrowseForFolder(0, "Select the My Documents folder", 9)
If Err.number<>0 Then
MsgBox "Error Setting up Browse for Folder"
Else
A = bff.ParentFolder.ParseName(bff.Title).Path
If err.number=424 then err.clear
tb2.value = A
End If
End Sub
Sub Search
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set objOutFile = fso.CreateTextFile("results.txt",True)
Dirname = tb2.value
Searchterm = tb1.value
ProcessFolder DirName
End Sub
Sub ProcessFolder(FolderPath)
On Error Resume Next
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
Set contents = thing.OpenAsTextStream
If err.number = 0 then
Test = Instr(contents.readall, searchterm)
If Isnull(test) = false then If Test > 0 then ObjOutFile.WriteLine thing.path
Else
err.clear
End If
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
ProcessFolder thing.path
Next
End Sub
</script>
</head>
<body>
<p><INPUT Name=tb1 TYPE=Text Value="Search">
<p><INPUT Name=tb2 TYPE=Text Value="Folder"> <INPUT NAME="Browse" TYPE="BUTTON" VALUE="Browse" OnClick=Browse>
<p><INPUT NAME="Search" TYPE="BUTTON" VALUE="Search" OnClick=Search>
</body>
</html>
I am using some vbscript to search for string inside a directory. Now I need my script to search for multiple instance of string in each file and return line number or some other identifiable information. My current vbscript is :-
Sub ProcessFolder(FolderPath)
On Error Resume Next
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
Set contents = thing.OpenAsTextStream
If err.number = 0 then
Test = Instr(contents.readall, searchterm)
If Isnull(test) = false then If Test > 0 then ObjOutFile.WriteLine thing.path
demo.innerHtml = demo.innerHtml & thing.path & "<br>"
Else
err.clear
End If
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
ProcessFolder thing.path
Next
End Sub
I need to iterate through lines of each file to get line numbers containing string.
Reads each line and searches each line. Also remembers the previous search and directory.
Two issues that you can fix.
It will now hits the 5 million statement timeout message esp if going through exe files.
It won't find Unicode text.
This is the third time I've written the program.
<HTML>
<HEAD><TITLE>Simple Validation</TITLE>
<SCRIPT LANGUAGE="VBScript">
Dim Dirname
Dim Searchterm
Dim FSO
Dim objOutFile
Sub Browse
On Error Resume Next
Set bffShell = CreateObject("Shell.Application")
Set bff = bffShell.BrowseForFolder(0, "Select the My Documents folder", 9)
If Err.number<>0 Then
MsgBox "Error Setting up Browse for Folder"
Else
A = bff.ParentFolder.ParseName(bff.Title).Path
If err.number=424 then err.clear
tb2.value = A
End If
End Sub
Sub Search
On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
WshShell.RegWrite "HKCU\Software\StackOverflow\VBS\Searchterm", tb1.value
WshShell.RegWrite "HKCU\Software\StackOverflow\VBS\Directory", tb2.value
Set fso = CreateObject("Scripting.FileSystemObject")
Set objOutFile = fso.CreateTextFile("results.txt",True)
Dirname = tb2.value
Searchterm = tb1.value
ProcessFolder DirName
End Sub
Sub ProcessFolder(FolderPath)
On Error Resume Next
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
Set contents = thing.OpenAsTextStream
If err.number = 0 then
Linenum = 0
Do Until contents.AtEndOfStream
line = contents.readline
Linenum = Linenum + 1
Test = Instr(line, searchterm)
If Isnull(test) = false then If Test > 0 then ObjOutFile.WriteLine LineNum & " " & thing.path
Loop
Else
err.clear
End If
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
ProcessFolder thing.path
Next
End Sub
Sub Init
On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
tb1.value = WshShell.RegRead("HKCU\Software\StackOverflow\VBS\Searchterm")
tb2.value = WshShell.RegRead("HKCU\Software\StackOverflow\VBS\Directory")
End Sub
</script>
</head>
<body Onload=Init>
<p><INPUT Name=tb1 TYPE=Text Value="Search">
<p><INPUT Name=tb2 TYPE=Text Value="Folder"> <INPUT NAME="Browse" TYPE="BUTTON" VALUE="Browse" OnClick=Browse>
<p><INPUT NAME="Search" TYPE="BUTTON" VALUE="Search" OnClick=Search>
</body>
</html>
I'm having an use where the <input type="file"> is locking the file for the ADODB.recordset.
If I hardcode the filepath the code runs without an issue however as soon as I browse using input type of file and select the hardcoded file it locks the file and I can no longer access it via the recordset.
I've tried just around everything I can think of without any success. I know its a result of the input browse function because if I select another file within the same directory or click the process button without browsing the code runs as it should.
Below is the relevant html and vbscript. Does anyone have any ideas on how to fix this?
<html>
<head>
<title>Employee Upload</title>
<HTA:APPLICATION
APPLICATIONNAME="Employee Upload"
ID="Employee Upload"
VERSION="1.0"/>
</head>
<body bgcolor="white">
<p id="heading" name="heading"><p>
<div id="container" name="container">
<span onClick="document.getElementById('myFile').click();" language="javascript" class="upload">
<button>Browse</button>
<input id="filename" type="text" disabled value="">
<input type="file" id="myFile" style="visibility:hidden;display:none;" onchange="document.getElementById('filename').value = this.value;document.getElementById('process').style.visibility = 'visible';" language="javascript">
</span>
<p>Click "Process File" once you have selected the file to upload the new hire data.</p>
<button id="process" name="process" onclick="loadFile()" style="/*visibility: hidden;*/">Process File</button>
</div>
<script language="vbscript">
Function loadFile()
On Error Resume Next
fileStr = document.all("filename").value
fileStr = "C:\Users\SeanW\Desktop\imports\NewHires.txt"
fileDir = Left(fileStr,InStrRev(fileStr,"\"))
filenameStr = Right(fileStr,Len(fileStr)-InStrRev(fileStr,"\"))
Set oConn = CreateObject("ADODB.Connection")
Set oRS = CreateObject("ADODB.Recordset")
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fileDir & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
oRS.Open "SELECT * FROM [" & filenameStr & "]", oConn, 3, 3, 1
If Err.Number <> 0 Then
MsgBox "Error Loading File: " & vbCrLf & vbCrLf & Err.Description,vbCritical,"File Load Error"
oConn.Close
oRS.Close
Set oConn = Nothing
Set oRs = Nothing
Err.Clear
Exit Function
else
Msgbox "File Loaded Successfully"
oConn.Close
oRS.Close
Set oConn = Nothing
Set oRs = Nothing
End If
End Function
</script>
</body>
</html>
I had exactly this problem today. I got around it by making a copy of the input file in a subfolder, then connecting to that with the ADODB.Connection
dim txtfile: txtfile = document.getElementById("filename").Value
dim fso: set fso = CreateObject("Scripting.FileSystemObject")
dim tablename: tablename = fso.GetFileName(txtfile)
' we'll create the folder as a subfolder to the current one
dim currentfolder: currentfolder = fso.GetAbsolutePathName(".")
' create new paths until we have a new one
dim newpath: newpath = fso.BuildPath(currentfolder, fso.GetTempName())
do while fso.folderExists(newpath)
newpath = fso.BuildPath(currentfolder, fso.GetTempName())
loop
' create the folder & copy the input file
fso.createFolder newpath
fso.copyfile txtfile, fso.buildpath(newpath, tablename)
'connect and process
ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & newpath & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
ado.open
'... etc
' clear up the temp folder
fso.deleteFolder newpath, true
First off new here and programming in general. I am trying to build an hta that can load various vbs scripts from an outside folder to make it more modular. I am current getting stuck at trying to open the vbs from my dynamic list. How do I open the file in my dynamic list? And also how do I pass a variable to the file? This is what I currently have:
<html>
<head>
<title>My HTML application</title>
<HTA:APPLICATION
APPLICATIONNAME="My HTML application"
ID="MyHTMLapplication"
VERSION="1.0"/>
</head>
<script language="VBScript">
Sub Window_OnLoad
Dim FolderPath
'folder to be searched for files
Dim objFSO
Dim objFolder
Dim colFiles
Dim objFile
Dim objOption
FolderPath = "%PathToScripts%"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FolderPath)
Set colFiles = objFolder.Files
For Each objFile in colFiles
Set objOption = Document.createElement("OPTION")
objOption.Text = objFile.Name
objOption.Value = objFile.Name
mylistbox.Add(objOption)
Next
End Sub
Sub RunProgram
Set objShell = CreateObject("Wscript.Shell")
objShell.Run objOption
End Sub
</script>
<body bgcolor="white">
<!--Add your controls here-->
<select name="mylistbox" size=10>
</select>
<input type="button" value="SingleSelect" onclick="RunProgram" name="RunScript">
<!--{{InsertControlsHere}}-Do not remove this line-->
</body>
</html>
Question 1: How do I open the file in my dynamic list?
First, you need to retrieve the selected value from your list. For single-selection lists, you can just query the Value property of the <select> element:
strFile = mylistbox.Value
Since nothing may be selected, it's always a good idea to test the result to make sure you got something:
If Len(strFile) > 0 Then
Also, it looks like you're just showing the file name in the list, not the file path, which is fine, but you'll need the full file path if you want to run the file later. So you have a couple of options, here. Option 1: Make FolderPath a global constant instead of a local variable so that you can access it from your RunProgram() routine. Option 2: Take advantage of the Value property of <option> elements to store the full path for each list item while still just displaying the file name. Here's how to do the latter:
Set objOption = Document.createElement("OPTION")
objOption.Text = objFile.Name
objOption.Value = objFile.Path ' Changed from objFile.Name to objFile.Path
mylistbox.Add(objOption)
Next
Now that you have the full path to your script, you can run it. This is what your RunProgram() routine could look like:
Sub RunProgram()
' Get the selected value. This will be a full file path.
strFile = mylistbox.Value
' Make sure something was selected.
If Len(strFile) > 0 Then
' Run the script file.
Set objShell = CreateObject("WScript.Shell")
objShell.Run Chr(34) & strFile & Chr(34)
End If
End Sub
Note: Chr(34) is used to add double quotes around the file name in case it contains spaces.
Question 2: How do I pass a variable to the file?
This is where things get a little trickier. Though you can run a VBScript directly using the Shell.Run command (as we did above), if you want to pass an argument to the script, you need to run it explicitly using one of the scripting engine executables.
objShell.Run "wscript.exe " & Chr(34) & strFile & Chr(34) & " " & Chr(34) & strParam & Chr(34)
Here, we're using wscript.exe (the "GUI" version of the Windows Scripting Host) to explicitly run our script file. We're surrounding our file with double quotes, as we did above. And, finally, we're adding a space to separate the "command" from the parameter. For completeness, we're also adding double quotes around the parameter in case it contains spaces as well.
I want to write a VBS macro to auto generate an email in outlook and attach a word document. I currently have a macro that does this for excel, but I can't get it to work for Word. I can't figure out for the life of me what my "FName= " should be. Any suggestions or help would be greatly appreciated. Here is what I have:
Sub AutoEmail()
On Error GoTo Cancel
Dim Resp As Integer
Resp = MsgBox(prompt:=vbCr & "Yes = Review Email" & vbCr & "No = Immediately Send" & vbCr & "Cancel = Cancel" & vbCr, _
Title:="Review email before sending?", _
Buttons:=3 + 32)
Select Case Resp
'Yes was clicked, user wants to review email first
Case Is = 6
Dim myOutlook As Object
Dim myMailItem As Object
Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(olMailItem)
FName = ActiveWord & "\" & ActiveWord.Name
With otlNewMail
.To = ""
.CC = ""
.Subject = ""
.Body = "Good Morning," & vbCr & vbCr & "" & Format(Date, "MM/DD") & "."
.Attachments.Add FName
.Display
End With
Set otlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
Set otlMess = Nothing
Set otlNSpace = Nothing
'If no is clicked
Case Is = 7
Dim myOutlok As Object
Dim myMailItm As Object
Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(olMailItem)
FName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
With otlNewMail
.To = ""
.CC = ""
.Subject = ""
.Body = "Good Morning," & vbCr & vbCr & " " & Format(Date, "MM/DD") & "."
.Attachments.Add FName
.Send
'.Display
'Application.Wait (Now + TimeValue("0:00:01"))
'Application.SendKeys "%s"
End With
'otlApp.Quit
Set otlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
Set otlMess = Nothing
Set otlNSpace = Nothing
'If Cancel is clicked
Case Is = 2
Cancel:
MsgBox prompt:="No Email has been sent.", _
Title:="EMAIL CANCELLED", _
Buttons:=64
End Select
End Sub
May it is a bit late, but I want to solve it for future use.
You want to have the active document as your file name (FName).
FName = Application.ActiveDocument.Path + "\" + Application.ActiveDocument.Name
' .Path returns only the Path where the file is saved without the file name like "C:\Test"
' .Name returns only the Name of the file, including the current type like "example.doc"
' Backslash is needed because of the missing backslash from .Path
otlNewMail.Attachements.Add FName
May you also want to save your current document before sending it via outlook, otherwise you will send the document without the changes made.
Function SaveDoc()
ActiveDocument.Save
End Function
I hope that this will help others, because the code from the question helped me a lot while scripting a similar script.