Would you be able to help me figure out/make pretty my code?
I have a file I need to edit and save some of it to next file. Saving is not an issue here, only editing.
I need to skip 2 lines and read next 30 or so to memory. Until now I've been using:
Const ForReading = 1
Const ForWriting = 2
set WshShell = WScript.CreateObject("WScript.Shell")
strMyDocs = WshShell.SpecialFolders("MyDocuments")
strDesktop = WshShell.SpecialFolders("Desktop")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDesktop & "\folder\blabla.vbs", ForReading)
strText = objFile.SkipLine & objFile.SkipLine
strText = objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine &
vbNewLine & objFile.ReadLine & vbNewLine &_
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine &
vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &_
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine &
vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &_
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine &
vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine
objFile.Close
...
As you can see it looks pretty lame, it does the job though.
I was able to find something to replace skilLine part:
For a = 1 to 30
If ((a =< 2) And (ObjFile.AtEndOfStream <> True)) Then
objFile.SkipLine
Do Until a = 30
objFile.ReadLine
Loop
Else
objFile.Close
End If
but cannot find a way to read next 28lines. I tried a lot and it always reads 28 lines but starting with line 31, not 3.
Could you help me?
Thanks
Here's another way.
' Read all lines into an array...
a = Split(objFSO.OpenTextFile(strDesktop & "\folder\blabla.vbs", ForReading).ReadAll, vbCrLf)
' Start with the 3rd line and read 28 lines (if available)...
For i = 2 To 29
If UBound(a) >= i Then strText = strText & a(i) & vbCrLf
Next
Does this work? Note the addition of the Do Until loop.
Const ForReading = 1
Const ForWriting = 2
set WshShell = WScript.CreateObject("WScript.Shell")
strMyDocs = WshShell.SpecialFolders("MyDocuments")
strDesktop = WshShell.SpecialFolders("Desktop")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDesktop & "\folder\blabla.vbs", ForReading)
objfile.SkipLine
objfile.SkipLine
Dim strText
Do Until objFile.AtEndOfStream
If(Len(strText) > 0) Then strText = strText & vbNewLine
strText = strText & objFile.ReadLine
Loop
objFile.Close
This will read a line if the rowcount is greater than 2 or less than 30, else it will skip the line, you can then do something with that line in strText
rowcount = 1
Do While NOT objFile.AtEndOfStream
if((rowcount > 2) And (rowcount < 30))Then
strText = objTextFile.Readline
'or strText = strText & vbCrLf & objTextFile.Readline
Else
strText = objTextFile.SkipLine
End If
rowcount = rowcount + 1
Loop
Related
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
'****************************************************************************
I am trying to gather all the shortcut information for all users (users y, x, z, and public.) However, currently my code is only able to search only 'Public' not the various other users folders found in "C:\Users" folder.
Here is the code I am using, but I need it to search thought the other user folders.
Option Explicit
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
sStartFolder = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs"
Dim sArguments
Dim sDescription
Dim sHotKey
Dim sIconLocation
Dim sWindowStyle
Dim sWorkingDirectory
Dim sTargetPath
Dim oFSO
Dim oShell
Dim sStartFolder
Dim NewFile
Dim objFolder
Dim colFiles
Dim objFile
Dim sShortcut
Dim sExtention
Dim oShortcut
Dim Subfolder
Dim oFile
Dim sDateCreated
Const sError = "-"
Const sFile = "C:\Users\Public\AllUserShortcutList.txt"
Set NewFile = oFSO.CreateTextFile(sFile, True)
WriteToFile NewFile, _
"Name" & vbTab & _
"Target" & vbTab & _
"Arguments" & vbTab & _
"Working Directory" & vbTab & _
"Icon Location" & vbTab & _
"Hot Key" & vbTab & _
"Shortcut Path" & vbTab & _
"Description" & vbTab & _
"WindowStyle" & vbTab & _
"Command line to launch in DOS" & vbTab & _
"Created On"
ShowFiles oFSO.GetFolder(sStartFolder)
ShowSubfolders oFSO.GetFolder(sStartFolder)
NewFile.Close
MsgBox "File Created:" & vbCrLf & vbCrLf & sFile
Sub ShowFiles (Folder)
Set objFolder = oFSO.GetFolder(Folder)
Set colFiles = objFolder.Files
For Each objFile In colFiles
If oFSO.GetExtensionName(LCase(objFile.Name)) <> "ini" Then
GetShortcutDetails sStartFolder & "\" & objFile.Name
Set oFile = oFSO.GetFile(sStartFolder & "\" & objFile.Name)
sDateCreated = oFile.DateCreated
WriteToFile NewFile, _
objFile.Name & vbTab & _
sTargetPath & vbTab & _
sArguments & vbTab & _
sWorkingDirectory & vbTab & _
sIconLocation & vbTab & _
sHotKey & vbTab & _
sStartFolder & vbTab & _
sDescription & vbTab & _
sWindowStyle & vbTab & _
"START /WAIT """ & oFSO.GetBaseName(objFile.Name) & _
""" """ & sTargetPath & """ " & sArguments & vbTab & _
sDateCreated
End If
Next
Set oFile = Nothing
End Sub
Sub ShowSubFolders(Folder)
For Each Subfolder In Folder.SubFolders
Set objFolder = oFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile In colFiles
If oFSO.GetExtensionName(LCase(objFile.Name)) <> "ini" Then
GetShortcutDetails Subfolder.Path & "\" & objFile.Name
Set oFile = oFSO.GetFile(Subfolder.Path & "\" & objFile.Name)
sDateCreated = oFile.DateCreated
WriteToFile NewFile, _
objFile.Name & vbTab & _
sTargetPath & vbTab & _
sArguments & vbTab & _
sWorkingDirectory & vbTab & _
sIconLocation & vbTab & _
sHotKey & vbTab & _
Subfolder.Path & vbTab & _
sDescription & vbTab & _
sWindowStyle & vbTab & _
"START /WAIT """ & oFSO.GetBaseName(objFile.Name) & _
""" """ & sTargetPath & """ " & sArguments & vbTab & _
sDateCreated
End if
Next
ShowSubFolders Subfolder
Next
End Sub
Sub WriteToFile (oFile,sText)
oFile.WriteLine(sText)
End Sub
Sub GetShortcutDetails (sFile)
Dim sExtention
Const sError = "-"
sExtention = oFSO.GetExtensionName(LCase(sFile))
If sExtention = "lnk" Then
' Find full path of shortcut
sShortcut = oFSO.GetAbsolutePathName(sFile)
'MsgBox sShortcut
Set oShortcut = oShell.CreateShortcut(sShortcut)
sTargetPath = oShortcut.TargetPath
sArguments = oShortcut.Arguments
sDescription = oShortcut.Description
sHotKey = oShortcut.HotKey
sIconLocation = oShortcut.IconLocation
sWindowStyle = oShortcut.WindowStyle
sWorkingDirectory = oShortcut.WorkingDirectory
Else
sTargetPath = sError
sArguments = sError
sDescription = sError
sHotKey = sError
sIconLocation = sError
sWindowStyle = sError
sWorkingDirectory = sError
End If
End Sub
I try to read a string char by char, and detect if there is any new line, and create an output if this is the case.
strText = "A;B;C" & vbcrlf & "D;E;F"
wscript.echo strText
For i=1 To Len(strText)
charx = Mid(strText,i,1)
if charx = "\n" then
wscript.echo "OMG, NEW LINE DETECTED!!!"
end if
Next
I tried it by comparing the readed char with "\n", but this failed.
Use InStr function as follows:
option explicit
'On Error Resume Next
On Error GoTo 0
Dim strText, strResult
strResult = Wscript.ScriptName
strText = "A;B;C" & vbcrlf & "D;E;F;vbCrLf"
strResult = strResult & vbNewLine & String(20, "-") & vbNewLine & testCrLf( strText) & strText
strText = "A;B;C" & vbNewLine & "D;E;F;vbNewLine"
strResult = strResult & vbNewLine & String(20, "-") & vbNewLine & testCrLf( strText) & strText
strText = "A;B;C" & vbCr & "D;E;F;vbCr"
strResult = strResult & vbNewLine & String(20, "-") & vbNewLine & testCrLf( strText) & strText
strText = "A;B;C" & vbLf & "D;E;F;vbLf"
strResult = strResult & vbNewLine & String(20, "-") & vbNewLine & testCrLf( strText) & strText
Wscript.Echo strResult
Wscript.Quit
Function testCrLf( sText)
If InStr(1, sText, vbCrLf, vbBinaryCompare) Then
testCrLf = "CrLf detected in "
Else
testCrLf = "CrLf not found in "
End If
End Function
Output:
==>cscript D:\VB_scripts\SO\32411401.vbs
32411401.vbs
--------------------
CrLf detected in A;B;C
D;E;F;vbCrLf
--------------------
CrLf detected in A;B;C
D;E;F;vbNewLine
--------------------
D;E;F;vbCround in A;B;C
--------------------
CrLf not found in A;B;C
D;E;F;vbLf
==>
if charx = vbLf then
wscript.echo "OMG, NEW LINE DETECTED!!!"
end if
In vbscript "\n" is a string with two characters, no a new line character
The simple way to identify new line is using Environment.NewLine
I googled a code that works just as I wanted,
But when I schedule it in task manager issue occurs ..after every pop up screen i need to click ok..then only the file gets updated.Please let me know what changes are to be done so that after running VBS it silently updates the file.
actual code:
source:http://www.wisesoft.co.uk/scripts/vbscript_disk_space_usage_report.aspx
OPTION EXPLICIT
CONST strComputer = "."
CONST strReport = "D:\diskspace.txt"
DIM objWMIService, objItem, colItems
DIM strDriveType, strDiskSize, txt
SET objWMIService = GETOBJECT("winmgmts:\\" & strComputer & "\root\cimv2")
SET colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType=3")
txt = "Drive" & vbtab & "Size" & vbtab & "Used" & vbtab & "Free" & vbtab & "Free(%)" & vbcrlf
FOR EACH objItem in colItems
DIM pctFreeSpace,strFreeSpace,strusedSpace
pctFreeSpace = INT((objItem.FreeSpace / objItem.Size) * 1000)/10
strDiskSize = Int(objItem.Size /1073741824) & "Gb"
strFreeSpace = Int(objItem.FreeSpace /1073741824) & "Gb"
strUsedSpace = Int((objItem.Size-objItem.FreeSpace)/1073741824) & "Gb"
txt = txt & objItem.Name & vbtab & strDiskSize & vbtab & strUsedSpace & vbTab & strFreeSpace & vbtab & pctFreeSpace & vbcrlf
NEXT
writeTextFile txt, strReport
wscript.echo "Report written to " & strReport & vbcrlf & vbcrlf & txt
' Procedure to write output to a text file
PRIVATE SUB writeTextFile(BYVAL txt,BYVAL strTextFilePath)
DIM objFSO,objTextFile
SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")
SET objTextFile = objFSO.CreateTextFile(strTextFilePath)
objTextFile.Write(txt)
objTextFile.Close
SET objTextFile = NOTHING
END SUB
Call the script with cscript script_file.vbs instead of wscript script_file.vbs.
Popup massage genarated by wscript.echo if you delete that line, code will run silently
wscript.echo "Report written to " & strReport & vbcrlf & vbcrlf & txt
I'm a beginner in VBscript and I got a script which obtains disk space usage of local drives. However, when some columns would contain long numeric value, some adjacent columns and even values are moving to the right and thus makes the output disorganized. I already
Please see below the contents of the script:
Option Explicit
const strComputer = "."
const strReport = "F:\dba_scripts\diskspace.txt"
Dim objWMIService, objItem, colItems
Dim strDriveType, strDiskSize, txt
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType=3")
txt = "DRIVE" & vbtab & vbtab & "SIZE" & vbtab & vbtab & "USED" & vbtab & vbtab & "FREE" & vbtab & vbtab & "FREE(%)" & vbcrlf
For Each objItem in colItems
DIM pctFreeSpace,strFreeSpace,strusedSpace
pctFreeSpace = INT((objItem.FreeSpace / objItem.Size) * 1000)/10
strDiskSize = round((objItem.Size /1073741824),1) & " GB"
strFreeSpace = round((objItem.FreeSpace /1073741824),1) & " GB"
strUsedSpace = round(((objItem.Size-objItem.FreeSpace)/1073741824),1) & " GB"
txt = txt & objItem.Name & vbtab & vbtab & strDiskSize & vbtab & vbtab & strUsedSpace & vbTab & vbtab & strFreeSpace & vbtab & vbtab & pctFreeSpace & vbcrlf
Next
writeTextFile txt,strReport
wscript.echo "Report written to " & strReport & vbcrlf & vbcrlf & txt
' Procedure to write output to a text file
private sub writeTextFile(byval txt,byval strTextFilePath)
Dim objFSO,objTextFile
set objFSO = createobject("Scripting.FileSystemObject")
set objTextFile = objFSO.CreateTextFile(strTextFilePath)
objTextFile.Write(txt)
objTextFile.Close
SET objTextFile = nothing
end sub
The output file looks OK but when I send/email it using the free bmail, the results are disorganized (meaning some columns and values moved to the right.
My question is are there ways to make the columns and values results fixed ( meaning no columns and values are moving to the right )?
Function RightJustified(ColumnValue, ColumnWidth)
RightJustified = Space(ColumnWidth - Len(ColumnValue)) & ColumnValue
End Function
Usage example:
output = output & _
RightJustified(strDiskSize, 15) & _
RightJustified(strUsedSpace, 15) & _
RightJustified(strFreeSpace, 15) & _
RightJustified(pctFreeSpace, 15) & _
vbCrLf
EDIT
Add the RightJustified function to your script.
Then, replace this line of your code:
txt = txt & objItem.Name & vbtab & vbtab & strDiskSize & vbtab & vbtab & strUsedSpace & vbTab & vbtab & strFreeSpace & vbtab & vbtab & pctFreeSpace & vbcrlf
with:
txt = txt & objItem.Name & _
RightJustified(strDiskSize, 15) & _
RightJustified(strUsedSpace, 15) & _
RightJustified(strFreeSpace, 15) & _
RightJustified(pctFreeSpace, 15) & _
vbCrLf
EDIT 2
I added the RightJustified function at the bottom of your script, and then called it within your loop to format the columns. I also used it on the column headers. Below is the script and at the bottom is the output on my machine.
Option Explicit
const strComputer = "."
const strReport = "F:\dba_scripts\diskspace.txt"
Dim objWMIService, objItem, colItems
Dim strDriveType, strDiskSize, txt
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType=3")
txt = RightJustified("DRIVE", 10) & _
RightJustified("SIZE", 15) & _
RightJustified("USED", 15) & _
RightJustified("FREE", 15) & _
RightJustified("FREE(%)", 15) & _
vbCrLf
For Each objItem in colItems
DIM pctFreeSpace,strFreeSpace,strusedSpace
pctFreeSpace = INT((objItem.FreeSpace / objItem.Size) * 1000)/10
strDiskSize = round((objItem.Size /1073741824),1) & " GB"
strFreeSpace = round((objItem.FreeSpace /1073741824),1) & " GB"
strUsedSpace = round(((objItem.Size-objItem.FreeSpace)/1073741824),1) & " GB"
txt = txt & _
RightJustified(objItem.Name, 10) & _
RightJustified(strDiskSize, 15) & _
RightJustified(strUsedSpace, 15) & _
RightJustified(strFreeSpace, 15) & _
RightJustified(pctFreeSpace, 15) & _
vbCrLf
Next
writeTextFile txt,strReport
wscript.echo "Report written to " & strReport & vbcrlf & vbcrlf & txt
' Procedure to write output to a text file
Sub writeTextFile(byval txt,byval strTextFilePath)
Dim objFSO,objTextFile
set objFSO = createobject("Scripting.FileSystemObject")
set objTextFile = objFSO.CreateTextFile(strTextFilePath)
objTextFile.Write(txt)
objTextFile.Close
Set objTextFile = nothing
End Sub
Function RightJustified(ColumnValue, ColumnWidth)
RightJustified = Space(ColumnWidth - Len(ColumnValue)) & ColumnValue
End Function
Output produced:
DRIVE SIZE USED FREE FREE(%)
C: 48.4 GB 40.6 GB 7.8 GB 16.1
D: 100.6 GB 56.8 GB 43.8 GB 43.5
You could write out a table using HTML. This should work in an email.