Create a text document from template VBScript - vbscript

I am using the following code to place and email in the Pickup directory of our SMTP server. Currently the entire file is composed inline. I would like to be able to use a template file wile place holders for the values to create the file since we are going to use HTML and want to change the email sometimes.
Dim objFSO 'As FileSystemObject
Dim objTextFile 'As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile("\\CampSaverS2\inetpub\mailroot\Pickup\"&rs.fields("OrderNumber")&".txt")
'rs.fields("OrderNumber") calls the order number, rs.fields("Name") calls customer name, app.S.get("Tracking_Number") calls tracking, rs.fields("email") for email
objTextFile.Write("to:"&rs.fields("email")& vbCrLf &_
"from:adsitest#campsaver.com"& vbCrLf &_
"subject:Tracking Test"& vbCrLf &_
"MIME-Version: 1.0"& vbCrLf &_
"Content-Type: text/html; charset=”iso-8859-1"& vbCrLf &_
"Content-Transfer-Encoding: quoted-printable"& vbCrLf &_
'HTML will go here
"Test email <br> Tracking info for order " & rs.fields("OrderNumber") & " is " & app.S.get("Tracking_Number") & vbCrLf & "Sent From ADSI.")
objTextFile.Close

You should be able to adapt this for your needs:
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objTemplateTS
Const ForReading = 1
Set objTemplateTS = objFSO.OpenTextFile("C:\MyTemplate.txt", ForReading, False)
Dim strAllTemplateText
strAllTemplateText = objTemplateTS.ReadAll()
objTemplateTS.Close()
strAllTemplateText = Replace(strAllTemplateText, "<Placeholder_One>", "My First New Value")
strAllTemplateText = Replace(strAllTemplateText, "<Placeholder_Two>", "My Second New Value")
Dim objOutputTS
Const ForWriting = 2
Set objOutputTS = objFSO.OpenTextFile("C:\Output.txt", ForWriting, True)
objOutputTS.Write(strAllTemplateText)
objOutputTS.Close()

Related

Error capturing number of document copies sent to printer using "Win32_PrintJob" Class

Am capturing the data from the documents that are sent to the printer
I use the class "Win32_PrintJob". I only need to get the number of copies of each document that was sent to print, for this I use the property 'PagesPrinted', but when trying to get the number of copies, returns the value "0". Looking at the documentation, there is the following explanation: "This value can be 0 (zero) if the print job does not contain page delimitation information." My question is, what would this "page delimitation" be? How to get the exact number of copies?
Official Documentation: Link
My Code in VBScript:
strComputer="."
strPrintQuery="Select * from __InstanceCreationEvent WITHIN 1 WHERE TargetInstance ISA 'Win32_PrintJob'"
Set PRINTSink=WScript.CreateObject("WBemScripting.SWbemSink","PRINTNEW_")
Set objWMI = GetObject("WinMgmts:{impersonationLevel=impersonate, (security)}!\\" & strComputer & "\")
objWMI.ExecNotificationQueryAsync PRINTSink,strPrintQuery
strPrintQuery2="Select * from __InstanceDeletionEvent WITHIN 1 WHERE TargetInstance ISA 'Win32_PrintJob'"
Set PRINTSink2=WScript.CreateObject("WBemScripting.SWbemSink","PRINTDEL_")
Set objWMI2 = GetObject("WinMgmts:{impersonationLevel=impersonate, (security)}!\\" & strComputer & "\")
objWMI2.ExecNotificationQueryAsync PRINTSink2,strPrintQuery2
strPrintQuery3="Select * from __InstanceModificationEvent WITHIN 1 WHERE TargetInstance ISA 'Win32_PrintJob'"
Set PRINTSink3=WScript.CreateObject("WBemScripting.SWbemSink","PRINTMOD_")
Set objWMI3 = GetObject("WinMgmts:{impersonationLevel=impersonate, (security)}!\\" & strComputer & "\")
objWMI3.ExecNotificationQueryAsync PRINTSink3,strPrintQuery3
strServiceQuery="Select * from __InstanceModificationEvent WITHIN 1 WHERE TargetInstance ISA 'Win32_Service'"
Set SERVICESink=WScript.CreateObject("WBemScripting.SWbemSink","SERVICEMOD_")
Set objWMI4 = GetObject("WinMgmts:{impersonationLevel=impersonate, (security)}!\\" & strComputer & "\")
objWMI4.ExecNotificationQueryAsync SERVICESink,strServiceQuery
While (True)
WScript.Sleep (500)
Wend
Sub PRINTNEW_OnObjectReady(objEvent,objContext)
WriteFile NOW & "f1 xxx " & objEvent.TargetInstance.PagesPrinted & " xxx " & objEvent.TargetInstance.DriverName & " xxx " & objEvent.TargetInstance.Owner & " xxx " & objEvent.TargetInstance.Name & " xxx " & objEvent.TargetInstance.Document
End Sub
Sub WriteFile(strText)
Dim objFSO, objFolder, objShell, objTextFile, objFile
Dim strDirectory, strFile
strDirectory = "C:
strFile = "\log.txt"
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
on error resume next
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript
objTextFile.WriteLine(strText)
objTextFile.Close
End Sub

Is there any way to show windows 10 toast notification using vbscript?

I'm trying to create and show notification in windows 10 using vbscript. i found a easy solution for mac, where i can easily show notification using this applescript
display notification "All graphics have been converted." with title "My Graphic Processing Script" subtitle "Processing is complete." sound name "Frog"
is there anything similar on windows for vbscript?
Here an example to show you how to write a .PS1 file (Powershell Script) and execute it from vbscript.
Option Explicit
Dim Ws,Ret,ByPassPSFile,PSFile
Set Ws = CreateObject("wscript.Shell")
ByPassPSFile = "cmd /c PowerShell.exe -ExecutionPolicy bypass -noprofile -file "
Call WritePSFile("Warning","10","'Please wait...'","' Scan is in progress....'","'Warning'","10")
Ret = Ws.run(ByPassPSFile & PSFile,0,True)
'------------------------------------------------------------------------------------------------------------
Sub WritePSFile(notifyicon,time,title,text,icon,Timeout)
Const ForWriting = 2
Dim fso,ts,strText
PSFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "ps1"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(PSFile,ForWriting,True)
strText = strText & "[reflection.assembly]::loadwithpartialname('System.Windows.Forms') | Out-Null;" & VbCrlF
strText = strText & "[reflection.assembly]::loadwithpartialname('System.Drawing') | Out-Null;" & VbCrlF
strText = strText & "$notify = new-object system.windows.forms.notifyicon;" & VbCrlF
strText = strText & "$notify.icon = [System.Drawing.SystemIcons]::"& notifyicon &";" & VbCrlF
strText = strText & "$notify.visible = $true;"
strText = strText & "$notify.showballoontip("& time &","& title &","& text &","& icon &");" & VbCrlF
strText = strText & "Start-Sleep -s " & Timeout &";" & VbCrlF
strText = strText & "$notify.Dispose()"
ts.WriteLine strText
End Sub
'------------------------------------------------------------------------------------------------------------
Edit :
Another example that can get your Public IP and your ISP and show them on the BallonTip.
Option Explicit
Dim Ws,Ret,ByPassPSFile,PSFile
Set Ws = CreateObject("wscript.Shell")
ByPassPSFile = "cmd /C PowerShell.exe -ExecutionPolicy bypass -noprofile -file "
Call WritePSFile(DblQuote("Warning"),"20",DblQuote("Public IP Information"),DblQuote(showIP),DblQuote("Warning"),"10")
Ret = Ws.run(ByPassPSFile & PSFile,0,True)
'------------------------------------------------------------------------------------------------------------
Sub WritePSFile(notifyicon,time,title,text,icon,Timeout)
Const ForWriting = 2
Dim fso,ts,strText
PSFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "ps1"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(PSFile,ForWriting,True)
strText = strText & "[reflection.assembly]::loadwithpartialname('System.Windows.Forms') | Out-Null;" & VbCrlF
strText = strText & "[reflection.assembly]::loadwithpartialname('System.Drawing') | Out-Null;" & VbCrlF
strText = strText & "$notify = new-object system.windows.forms.notifyicon;" & VbCrlF
strText = strText & "$notify.icon = [System.Drawing.SystemIcons]::"& notifyicon &";" & VbCrlF
strText = strText & "$notify.visible = $true;"
strText = strText & "$notify.showballoontip("& time &","& title &","& text &","& icon &");" & VbCrlF
strText = strText & "Start-Sleep -s " & Timeout &";" & VbCrlF
strText = strText & "$notify.Dispose()"
ts.WriteLine strText
End Sub
'------------------------------------------------------------------------------------------------------------
Function ShowIP()
Dim http,strJson,j,Info
Set http = CreateObject("Msxml2.XMLHTTP")
http.open "GET","http://ip-api.com/json/",False
http.send
strJson = http.responseText
Set j = Parse(strJson)
Info = Info & "IP="&j.query & vbCrLf &_
"ISP="&j.isp & vbCrLf &_
"Country="&j.country & vbCrLf &_
"City="&j.city
ShowIP = Info
End Function
'------------------------------------------------------------------------------------------------------------
Function Parse(strJson)
Dim html,window
Set html = CreateObject("htmlfile")
Set window = html.parentWindow
window.execScript "var json = " & strJson, "JScript"
Set Parse = window.json
End Function
'------------------------------------------------------------------------------------------------------------
Function DblQuote(Str)
DblQuote = chr(34) & Str & chr(34)
End function
'------------------------------------------------------------------------------------------------------------
Another way with vbscript without powershell but using the object CreateObject('Internet.HHCtrl').TextPopup
Option Explicit
Dim http,strJson,j,Info,HH
Set http = CreateObject("Msxml2.XMLHTTP")
http.open "GET","http://ip-api.com/json/",False
http.send
strJson = http.responseText
Set j = Parse(strJson)
Info = Info & "IP="&j.query & vbCrLf &_
"ISP="&j.isp & vbCrLf &_
"Country="&j.country & vbCrLf &_
"City="&j.city & vbCrLf &_
"TimeZone="&j.timezone & vbCrLf &_
"CountryCode="&j.countryCode & vbCrLf &_
"org="&j.org & vbCrLf &_
"AS="&j.as & vbCrLf &_
"Latitude="&j.lat & vbCrLf &_
"Longitude="&j.lon
Set HH = CreateObject("Internet.HHCtrl")
HH.TextPopup Info,"Verdana,12",12,12,12,12
WScript.Sleep 10000
Wscript.Quit()
'****************************************************************************
Function Parse(strJson)
Dim html,window
Set html = CreateObject("htmlfile")
Set window = html.parentWindow
window.execScript "var json = " & strJson, "JScript"
Set Parse = window.json
End Function
'****************************************************************************

Reading text file gives me weird string chain. cant get throu making a string variable of lines in text file

I am trying to make a little script in VBS that saves command output to text file and then reading line by line from it and placing it straigh to variable.
Unfortunetly effects are weird. Instead of having a string with all lines from file I have weird chain like "ybN" (see the screenshot below). I tried to read file with many different ways found on the Internet but effects are worse or the same.
I noticed that command output is saving with many spaces after each text but I don't know if that's what causing the problem.
Any Suggestions?
Const ForWriting = 2
Const ForReading = 1
Set WshShell = CreateObject("WScript.Shell")
If WScript.Arguments.Length = 0 Then
Set ObjShell = CreateObject("Shell.Application")
ObjShell.ShellExecute "wscript.exe" _
, """" & WScript.ScriptFullName & """ RunAsAdministrator", , "runas", 1
WScript.Quit
End If
Set fsoObject = CreateObject("Scripting.FileSystemObject")
strFile = "D:\interfaces.txt"
WshShell.Run("%comspec% /C wmic nic where " & Chr(34) & "netconnectionid like '%'" & Chr(34) & " get netconnectionid >> " & Chr(34) & strFile & Chr(34))
WScript.Echo "Interface data pushed to text file at " & strFile
If fsoObject.FileExists(strFile) Then
If fsoObject.GetFile(strFile).Size <> 0 Then
Set objFile = fsoObject.OpenTextFile(strFile, ForWriting)
objFile.Write ""
objFile.Close
End If
End If
Set objFile = fsoObject.OpenTextFile(strFile, ForReading)
Do Until objFile.AtEndOfStream
strMsg = strMsg & objFile.ReadLine & vbNewLine
'strMsg = strMsg & strLine & vbNewLine
Loop
objFile.Close
sInput = InputBox("Choose network connection to configurate " & vbNewLine & strMsg, ,"Choose one option")
Screenshots:
Your file is Unicode-encoded (little endian UTF-16 to be precise). ÿþ is the byte order mark (BOM) for this encoding. You need to open it as such by setting the fourth parameter of OpenTextFile() to -1:
Set objFile = fsoObject.OpenTextFile(strFile, ForReading, False, -1)

How can I pull the correct data from the HK Current User registry key instead of temp profile information

I am working on a script to pull the value in the key
HKCurrentUser\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Desktop
Currently all it is returning is:
C:\WINDOWS\system32\config\systemprofile\Desktop
When I want/think it should return:
%USERPROFILE%\Desktop
Below is the script that is pulling the infomration from the key and as far as I can tell it should be pulling the correct information. Just wondering if someone can enlighten me as to what I am missing. It also returns the computer name and the logged in username which both return correctly. This is going to be run on quite a few machines remotely.
'These are the constants for the following KEYS'
Const HKClassesRoot = &H80000000 'HKEY_CLASSES_ROOT
Const HKCurrentUser = &H80000001 'HKEY_CURRENT_USER
Const HKLocalMachine = &H80000002 'HKEY_LOCAL_MACHINE
Const HKUsers = &H80000003 'HKEY_USERS
Const HKCurrentConfig = &H80000005 'HKEY_CURRENT_CONFIG
'Setup objects to interact with here'
Set wshShell = WScript.CreateObject("Wscript.Shell")
strComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Define variable to store the current user and then pull the current user
Dim currentUser
strCurrentUser = objNetwork.UserName
'find the data in the string we want to get the value from'
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\"
strValueName = "Desktop"
'pull the info and store it in strValue'
objRegistry.GetStringValue HKCurrentUser,strKeyPath,strValueName,strValue
'setup for output of data to the file'
Dim strSpacer
Dim strData
strSpace = "+-------------------------------------------------------------------------------------------------------------------------+"
strData = "| " & strComputer & " == " & strCurrentUser & " == " & strValue & " |"
Dim strFileName
strFileName = "\\server\share\" & strCurrentUser & ".txt"
Set objFile = objFSO.OpenTextFile(strFileName,8,true)
objFile.write vbCrLf & strSpace & vbCrLf
objFile.write strData & vbCrLf
objFile.write strSpace & vbCrLf
'Close file'
objFile.Close
After review I found the answer to my own question. I was reading the registry incorrectly for what I was doing.
strRegkey = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Desktop"
strDataValue = wshShell.RegRead(strRegKey)
this returns the value stored currently in the key.
I suspect that the environment variable %USERPROFILE% from the registry value gets expanded to the profile of the user running the WMI service (LOCAL SYSTEM). GetStringValue seems to behave the same as GetExpandedStringValue when reading REG_EXPAND_SZ values.

HTA(vbs) - To do list - delete or modify array items

I'm trying to create an HTA To Do List saving locally to a text file. Every time you press submit button generates a new entry that display inside hta body and it's being saved inside the text file. I want to develop this furthermore :
delete an entry and update body/text file
modify an entry and update body/text file
put new entry on top
Any suggestions?
<html>
<head>
<HTA:APPLICATION SINGLEINSTANCE="yes" APPLICATIONNAME="To Do List">
</head>
<SCRIPT Language="VBScript">
Sub Window_OnLoad
ReadBlog
End Sub
Sub SaveData
strDel1="<"
strDel2=">"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("C:\Test.txt") Then
Set objFile = objFSO.OpenTextFile("C:\Test.txt", 8)
strLine = strDel1 & Time & vbTab & Date & vbTab & Title.Value & vbTab & Message.Value & strDel2
objFile.WriteLine strLine
objFile.Close
Else
Set objFile = objFSO.CreateTextFile("C:\Test.txt")
strLine = strDel1 & Time & vbTab & Date & vbTab & Title.Value & vbTab & Message.Value & strDel2
objFile.WriteLine strLine
objFile.Close
End If
ReadBlog
ClearText
End Sub
Sub ReadBlog
Const ForReading = 1, ForWriting = 2
dim sampletext, objRegExp, SearchPattern, ReplacePattern, matches
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\Test.txt", ForReading)
Do Until objFile.AtEndOfStream
sampletext = objFile.ReadAll
SearchPattern = "<"
SearchPattern = SearchPattern & "(.*?)([\s\S]*?)"
SearchPattern = SearchPattern & ">"
Set objRegExp = New RegExp
objRegExp.Pattern = searchpattern ' apply the search pattern
objRegExp.Global = True ' match all instances if the serach pattern
objRegExp.IgnoreCase = True ' ignore case
Set matches = objRegExp.execute(sampletext)
If matches.Count > 0 Then ' there was at least one match to the search pattern
i=0
For Each match in matches
arrEntry = Split(Split(match.Value, "<")(1), ">")(0)
arrFields = Split(arrEntry, vbTab)
strTime = arrFields(0)
strDate = arrFields(1)
strTitle = arrFields(2)
strMessage = arrFields(3)
strHTML = strHTML & "<p>" & strTime & "</p>"
strHTML = strHTML & "<p>" & strDate & "</p>"
strHTML = strHTML & "<p>" & strTitle & "</p>"
strHTML = strHTML & "<p>" & strMessage & "</p>"
strHTML = strHTML & "<input type='button' name='Delete' value='Delete' >"& i &"<p>"
i=i+1
Next
Else ' there were no matches found
MsgBox objRegExp.Pattern & "was not found in the string"
End If
Loop
DataArea.InnerHTML = strHTML
Set objRegExp = Nothing
Set objFSO = Nothing
End Sub
Sub ClearText
Title.Value = ""
Message.Value = ""
End Sub
</SCRIPT>
<body>
<input type="text" name="Title" size="101"><p>
<textarea rows="10" cols="76" type="text" name="Message" size="25"></textarea><p>
<input type="button" value="Submit" onClick="SaveData">
<p><div id="DataArea"></div></p>
</body>
</html>
Are you particularly tied to using text files? If you used a database (such as access) you could do this quite easily (you don't have to have access installed to use an access database with an HTA either). And it would open up some other possibilities.
Incidentally, I also notice you're doing this:
strHTML = strHTML & "<p>" & strTime & "</p>"
strHTML = strHTML & "<p>" & strDate & "</p>"
strHTML = strHTML & "<p>" & strTitle & "</p>"
strHTML = strHTML & "<p>" & strMessage & "</p>"
Not a big thing, but concatenating the strings like that isn't great for performance. You'd be better off writing it all to the variable at the same time, otherwise it has to keep writing the variable to memory over and over again.
If you want to read a file with HTA you can easily do it in javaScript. Since the context changes IE allws you to directly read file on the computer or the network to wich the computer is linked to. In order to do so, you need to access the File System Object (FSO)
Full Documentation on FSO
If you are still looking to access a database you need to use the ADODB.Connection. That will allow you to connect to database localy or remotely. Altought there is not much documentation on the subject we did it at my work place. With a little imagination you can figure out how to fix it.
Documentation on the ADODB.Connnect
In this documentation the example are in VB but you can write them in JS as well.

Resources