Archive - June 2012

"Motivation will almost always beat mere talent." - Norman R. Augustine

Index

Combine Excel Files
Convert CSV to Excel
Convert Excel to CSV
Determine 32bit 64bit OS
Draw Excel Pie Chart using VBScript
Iterate through Folders
Sort Servers/Web Sites by Response Time

Forensic Script
Create Simple Event log
Compare WMI Device IDs
Stop Java Pop-ups
Simulate Left Mouse Click

Δ Saturday, June 30th, 2012

Δ Combine Excel Files

How to combine excel files

[download resource files]

Demo

This script will take 2 excel files and basically combine them into one excel file with a new excel file name.
It uses the Excel.Application to interface with the excel application, and actually lets excel do the work.
As you can see, it shuffles around worksheets until the final output is the new specified file.

'  
'======================================
' combine 2 Excel workbooks into single file with multiple sheets
'======================================

'pExcelFile1 = Wscript.Arguments(0)
'pExcelFile2 = Wscript.Arguments(1) 
'pOutputName = Wscript.Arguments(2)

pExcelFile1 = "E:\Users\TestUser\Desktop\file1.xlsx"
pExcelFile2 = "E:\Users\TestUser\Desktop\file2.xlsx"
pOutputName= "E:\Users\TestUser\Desktop\combined.xlsx"

On Error Resume Next ' Turn on the error handling flag
Set objExcel = GetObject(,"Excel.Application")
'If not found, create a new instance.
If Err.Number = 429 Then  '> 0
  Set objExcel = CreateObject("Excel.Application")
End If

objExcel.Visible = false
objExcel.displayalerts=false

Set     wbSource = objExcel.Workbooks.Open(pExcelFile1)
Set objWorkbook1 = objExcel.Workbooks.open(pExcelFile2)

wbSource.Activate
wbSource.UsedRange.Select

objWorkbook1.Sheets.Copy , wbSource.Sheets(1)

'rename worksheets
wbSource.Sheets(1).Name = wbSource.Name 
wbSource.Sheets(2).Name = objWorkbook1.Name

wbSource.Sheets(1).Select

'Save Spreadsheet, 51 = Excel 2007-2010 
wbSource.SaveAs pOutputName, 51

'Release Lock on Spreadsheet
objExcel.Quit()
Set ObjExcel = Nothing
Set wbSource = Nothing
Set objWorkbook1 = Nothing
Set pExcelFile1 = Nothing
Set pExcelFile2 = Nothing

Δ [email me]

Δ Thursday, June 21th, 2012

Δ Convert CSV to Excel

How to convert csv to excel

[download resource files]

Demo

Just like in the script above, this script uses the Excel.Application to interface with the Excel Application.
The script just imports the CSV, fits it to the columns, performs a few excel tasks like making headings
bold, and then saves, thus converting it from CSV to XLS.

'Syntax
'Excel_To_CSV_All_Worksheets.vbs  C:\folder name\File_Name.xlsx

'======================================
' Convert CSV to XLS
'
' arg1: source - CSV path\file
' arg2: target - Excel path\file
'======================================

srccsvfile = Wscript.Arguments(0)  
tgtxlsfile = Wscript.Arguments(1)

'Create Spreadsheet
'Look for an existing Excel instance.
On Error Resume Next ' Turn on the error handling flag
Set objExcel = GetObject(,"Excel.Application")
'If not found, create a new instance.
If Err.Number = 429 Then  '> 0
  Set objExcel = CreateObject("Excel.Application")
End If

objExcel.Visible = false
objExcel.displayalerts=false

'Import CSV into Spreadsheet
Set objWorkbook = objExcel.Workbooks.open(srccsvfile)
Set objWorksheet1 = objWorkbook.Worksheets(1)

'Adjust width of columns
Set objRange = objWorksheet1.UsedRange
objRange.EntireColumn.Autofit()
'This code could be used to AutoFit a select number of  columns
'For intColumns = 1 To 17
'    objExcel.Columns(intColumns).AutoFit()
'Next

'Make Headings Bold
objExcel.Rows(1).Font.Bold = TRUE

'Freeze header row
With objExcel.ActiveWindow
     .SplitColumn = 0
     .SplitRow = 1
End With
objExcel.ActiveWindow.FreezePanes = True

'Add Data Filters to Heading Row
objExcel.Rows(1).AutoFilter

'set header row gray
objExcel.Rows(1).Interior.ColorIndex = 15
'-0.249977111117893

'Save Spreadsheet, 51 = Excel 2007-2010 
objWorksheet1.SaveAs tgtxlsfile, 51

'Release Lock on Spreadsheet
objExcel.Quit()
Set objWorksheet1 = Nothing
Set objWorkbook = Nothing
Set ObjExcel = Nothing

Δ [email me]

Δ Sunday, June 17th, 2012

Δ Convert Excel to CSV

How to convert excel to csv

[download resource files]

Demo

This script takes the data inside an excel spreadsheet and perorms a generic save as CSV, thus
convertiing it from XLS to CSV. The important part is the instantiated object: Set objXL =
CreateObject "Excel.Application").

'Notice the required input parameters:

'1.the folder path and name of the CSV file
'2.the folder path and name of the new Excel file

'  XLS_To_CSV.vbs
' =============================================================
'  convert all NON-empty worksheets in an Excel file to csv
'  CSV file names will default to Sheet names
'  output folder defaults to the folder where the script resides or
'  if path is specified with the input file, that path is used
'  
'  input parameter 1:  Excel path\file in argument 1 
'                     (if path is not specified, the current path is defaulted)
'  
' ============================================================

Dim strExcelFileName
Dim strCSVFileName

strExcelFileName = WScript.Arguments.Item(0)  'file name to parses

' get path where script is running
Set fso = CreateObject ("Scripting.FileSystemObject")  'use this to find current path
strScript = Wscript.ScriptFullName
strScriptPath = fso.GetAbsolutePathName(strScript & "\..")

' If the Input file is NOT qualified with a path, default the current path
LPosition = InStrRev(strExcelFileName, "\") 
if LPosition = 0 Then 'no folder path
    strExcelFileName = strScriptPath & "\" & strExcelFileName
strScriptPath = strScriptPath & "\" 
else                 'there is a folder path, use it for the output folder path also
strScriptPath = Mid(strExcelFileName, 1, LPosition) 
End If
' msgbox LPosition & " - " & strExcelFileName & " - " & strScriptPath  ' use this for debugging

Set objXL = CreateObject("Excel.Application")
Set objWorkBook = objXL.Workbooks.Open(strExcelFileName)
objXL.DisplayAlerts = False

' loop over worksheets
  For Each sheet In objWorkBook.Sheets  
      'only saveAS sheets that are NOT empty
if objXL.Application.WorksheetFunction.CountA(sheet.Cells) <> 0 Then 
'             sheet.Rows(1).delete  ' this will 'ove Row 1 or the header Row
sheet.SaveAs strScriptPath & sheet.Name & ".csv", 6  'CSV
   End If
  Next

' clean up  
objWorkBook.Close 
objXL.quit
Set objXL = Nothing 
Set objWorkBook = Nothing
Set fso = Nothing

' end script

Δ [email me]

Δ Saturday, June 16th, 2012

Δ Determine 32bit 64bit OS

How to return bit version

[download resource files]

Demo

This script uses a simple reg key string comparison to return whether the operating system is either 32 bit
or 64 bit.

'================================================================

Const HKEY_LOCAL_MACHINE = &H80000002
'Lines to get the computer Name

Set wshShell = WScript.CreateObject( "WScript.Shell" )
 strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
 
  
'===============================================================
 'To check whether the OS is 32 bit or 64 bit of Windows 7
'===============================================================

'Lines to detect whether the OS is 32 bit or 64 bit of Windows 7

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerName & "\root\default:StdRegProv")

strKeyPath = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"

strValueName = "Identifier"
 
 oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
'===============================================================

'Checking Condition whether the build is 64bit or 32 bit

if (instr(strValue,"64")) then
    msgbox "64 bit - you can comment this line out"
   'Perform functions for 64-bit OS.
 End If

if (instr(strValue,"x86")) then
   msgbox "32 bit - you can comment this line out"
  'Perform functions for 32-bit OS
 End If
'===============================================================

Δ [email me]

Δ Wednesday, Juney 13th, 2012

Δ Draw Excel Pie Chart using VBScript

How to draw charts in excel

[download resource files]

Demo

Pretty cool script that will draw a pie chart based upon the specified data. By interfacing into Excel using
Set oExl=CreateObject("Excel.Application"), the script can then pass commands for excel to perform the
chart creation.

Function CreateChart()

On Error Resume next
Dim oExl,oWrkbk,oWrkst,oMychart

Set oExl=CreateObject("Excel.Application")

With oExl

.Visible=True

End With

Set oWrkbk=oExl.Workbooks.Add()
Set oWrkst=oWrkbk.Worksheets(1)

With oWrkst
.Cells(1,1)="Critical"
.Cells(2,1)="Very Serious"
.Cells(3,1)="Serious"
.Cells(4,1)="Moderate"
.Cells(5,1)="Mild"

.Cells(1,2)="Bugs Severity"

For i=2 to 5

.Cells(i,2)=i+21

If i>4 Then
 .Cells(5,2)=9
 End If

End With
Set oRange=oWrkst.UsedRange
oRange.Select
Set oChart=oExl.charts
oChart.Add()
Set oMychart=oChart(1)
oMychart.Activate
oMychart.ChartType=5
oMychart.ApplyDataLabels 5

oMychart.PlotArea.Fill.Visible=False
oMychart.PlotArea.Border.LineStyle=-4142
oMychart.SeriesCollection(1).DataLabels.Font.Size=15
oMychart.SeriesCollection(1).DataLabels.Font.ColorIndex=2

oMychart.ChartArea.Fill.Forecolor.SchemeColor=49
oMychart.ChartArea.Fill.Backcolor.SchemeColor=14
oMychart.ChartArea.Fill.TwoColorGradient 1,1

oMychart.ChartTitle.Font.Size=20
oMychart.ChartTitle.Font.ColorIndex=4
'oWrkbk.Close
Set oExl=Nothing

If err.number<>0 then

Msgbox "error occurred while drawing..."
 Msgbox err.Description

Else

Msgbox  "Successfully drawn"

End If

End Function

CreateChart()

Δ [email me]

Δ Sunday, June 10th, 2012

Δ Iterate through Folders

How to iterate through folders

[download resource files]

Demo

You just never know when you're going to need to perform a function on a folder and its subfolders;
that's exactly what this script allows you to do. It uses a simple "for each" to setup a cycle through
routine.

Δ [email me]

Δ Saturday, June 9th, 2012

Δ Sort Servers/Web Sites by Response Time

How to sort with response time

[download resource files]

Demo

Okay, so let's say you have 10 file servers dispersed through your enterprise. When users are
downloading and running apps (or you are just deploying ondemand apps to their desktops) you
want to make sure they are using the fastest server available once the installation has been
started - kind of a perferred server based upon network/lan/wan speed; that's exactly what this
script can do. It returns in order from fastest to slowest connections which could be integrated
into your own scripts to perform all kind speed based tasks. You just have to add the logic
"if this" - "do this"

Dim arr : arr = Array( "GOOGLE.COM" , "YAHOO.COM" , "BLANK-does-not-exist" , "LOCALHOST")
Dim out
Call ServersByPingTime( arr , out , True )
Dim s

WScript.Echo "In order fastest to slowest: "
For Each S in out
	WScript.Echo s
Next

' Ping function will work on Windows 2000 and Windows XP without using the Win32_PingStatus
Function Ping(strHost , ByRef bytesSent , ByRef bytesReceived , ByRef bytesLost , ByRef minMs , ByRef maxMs , ByRef aveMs )
	Ping = False
	Dim objShell, objExec, strPingResults, bRet
	Set objShell = CreateObject("WScript.Shell")
	WScript.Echo "Testing Speed for: " & strHost
	Set objExec = objShell.Exec("ping -n 1 " & strHost)	
	Do
   		WScript.Sleep 100
	Loop Until objExec.Status <> 0
	strPingResults = objExec.StdOut.ReadAll
	Dim regexpingstats : Set regexpingstats = new regexp
 	regexpingstats.Pattern = "Packets:\s+Sent\s+=\s+([0-9]+).*Received\s+=\s+([0-9]+).*Lost\s+=\s+([0-9]+)(?:.*\s)+Minimum\s+=\s+([0-9]+)ms.*Maximum\s+=\s+([0-9]+)ms.*Average\s+=\s+([0-9]+)ms"
	regexpingstats.Global = True
	regexpingstats.IgnoreCase = True
	regexpingstats.MultiLine = True
	If regexpingstats.Test(strPingResults) Then
		Dim m : Set m = regexpingstats.Execute(strPingResults)
		bytesSent = CInt(m.Item(0).subMatches.Item(0))
		bytesReceived = CInt(m.Item(0).subMatches.Item(1))
		bytesLost = CInt(m.Item(0).subMatches.Item(2))
		minMs = CInt(m.Item(0).subMatches.Item(3))
		maxMs = CInt(m.Item(0).subMatches.Item(4))
		aveMs = CInt(m.Item(0).subMatches.Item(5))
		Ping = Eval( bytesSent > bytesLost )
	End If
End Function

'Returns false if no server were found alive
'outSortedByMs - array sorted fastest response to slowest response time
Public Function ServersByPingTime( ByVal inSeverList , ByRef outSortedByMs , bVerbose )
		On Error Resume Next
		ServersByPingTime = False
		outLivingSorted = Array
		Dim s, i , j , temp
		If bVerbose Then WScript.Echo("[Performing Connectivity Test of Defined Servers]")
		For Each s In inSeverList 
			If bVerbose Then wscript.StdOut.Write("        Server: " & s )
			Dim bs, br, bl, mi , ma , av
			If Ping( s , bs, br, bl, mi , ma , av ) Then
				If bVerbose Then
					'WScript.Echo(" [Passed]")
					'WScript.Echo("    Bytes Sent: " & bs )
					'WScript.Echo("    Bytes Recv: " & br )
					'WScript.Echo("    Bytes Lost: " & bl )
					'WScript.Echo("        Min ms: " & mi )
					'WScript.Echo("        Max ms: " & ma )
					'WScript.Echo("    Average ms: " & av )
					'WScript.Echo("")
				End If 
				i = UBound(outLivingSorted) + 1		
				ReDim Preserve outLivingSorted(i)
				outLivingSorted(i) = Array(s,av)
				ServersByPingTime = True ' Success there are servers alive... 
			Else 
				If bVerbose Then 
					WScript.Echo(" [Failed]")
					WScript.Echo("")
				End if
			End If 
		Next
		'Sort...
		For i = UBound(outLivingSorted) - 1 To 0 Step -1
	    	For j = 0 To i
	    	    If outLivingSorted(j)(1) > outLivingSorted(j+1)(1) Then
	            	temp=outLivingSorted(j+1)
	            	outLivingSorted(j+1)=outLivingSorted(j)
		            outLivingSorted(j)=temp
	    	    End If
	        Next
	    Next 
	    'Temp array to store the new pinged and sorted by reponse time...
		Dim temparray
		ReDim temparray(UBound(outLivingSorted))
	   	For i = 0 To UBound(outLivingSorted) 
	   		temparray(i) = outLivingSorted(i)(0)
	   	Next
	   	outSortedByMs = temparray
	End Function

Δ [email me]

Δ Thursday, June 7th, 2012

Δ Forensic Script

How to check a user's machine for non-authorized files

[download resource files]

Have you ever wanted to know exactly which users have music, videos and other non-authorized file types on
their computers? Well, this script will allow you to scan their machine and return whether they are guilty or
non-guilty of violating the business' storage policies.

'=== Force declaration of ALL variables (variants)
Option Explicit
On Error Resume Next

'=== UNC Path is not valid from command prompt
'Const LOGFILE = "\\XXXXXXX\Public\scan\mp3\guilty\"
'Const LOGFILE2 = "\\XXXXXXX\Public\scan\mp3\not guilty\"

'used for testing'''''''''''''''''''''''
Const LOGFILE = "C:\temp\guilty\"
Const LOGFILE2 = "C:\temp\notguilty\"
''''''''''''''''''''''''''''''''''''''''

Const BASEDIR = "C:\"

'Constant Required for OpenTextFile function
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

'=== Global variables
Public gLogFile
Public pusername

'=== Variables declaration required because of Option Explicit
Dim objFS
Dim objNetwork
Dim objFileLog
Dim tCompName
Dim tRootFolder
Dim tOutput
Dim objShell
Dim dicExcludedServers
Dim dicExcludedFolders
Dim dicIncludedExtensions
Dim intFound

'=== Create needed objects
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject( "WScript.Shell" )
Set objNetwork = CreateObject("WScript.Network")

'Excluded servers are listed here
Set dicExcludedServers = CreateObject("Scripting.Dictionary")
dicExcludedServers.CompareMode = vbTextCompare
dicExcludedServers.Add "server1", 0
dicExcludedServers.Add "server2", 0
dicExcludedServers.Add "server3", 0
dicExcludedServers.Add "server4", 0
dicExcludedServers.Add "server5", 0

'Excluded folders are listed here
Set dicExcludedFolders = CreateObject("Scripting.Dictionary")
dicExcludedFolders.CompareMode = vbTextCompare
dicExcludedFolders.Add "c:\windows", 0
dicExcludedFolders.Add "c:\program files", 0
dicExcludedFolders.Add "c:\program files (x86)", 0
dicExcludedFolders.Add "c:\$recycle.bin", 0
dicExcludedFolders.Add "c:\users\public\music\sample music", 0
dicExcludedFolders.Add objShell.ExpandEnvironmentStrings("%USERPROFILE%\appdata\local\microsoft\windows\temporary internet files"), 0
dicExcludedFolders.Add "C:\Users\Public\Videos", 0
dicExcludedFolders.Add "c:\SWSetup", 0
dicExcludedFolders.Add "C:\ProgramData", 0
dicExcludedFolders.Add "C:\Users\All Users\Microsoft\Windows\Ringtones", 0

'Included extensions are listed here
Set dicIncludedExtensions = CreateObject("Scripting.Dictionary")
dicIncludedExtensions.CompareMode = vbTextCompare
dicIncludedExtensions.Add "mp3", 0
dicIncludedExtensions.Add "avi", 0
dicIncludedExtensions.Add "mpeg", 0
dicIncludedExtensions.Add "mpg", 0
dicIncludedExtensions.Add "wmv", 0
dicIncludedExtensions.Add "mp4", 0
dicIncludedExtensions.Add "wma", 0
dicIncludedExtensions.Add "acc", 0
dicIncludedExtensions.Add "m4a", 0
dicIncludedExtensions.Add "m4b", 0

'=== Get the computer name.
tCompName = LCase(objNetwork.ComputerName)
pusername = objNetwork.UserName

' See if we should skip this server
If dicExcludedServers.Exists(tCompName) Then
   Wscript.Quit
End If

'=== Create the log file based on computer name. Create a log file for mp3 files.
gLogFile = LOGFILE & tCompName & ".log"

'=== Get LOGFILE object ready for appending
Set objFileLog = objFS.OpenTextFile(gLogFile, ForAppending, True)

'=== Call FindFiles on the c:\ drive
intFound = FindFiles(objFS.GetFolder(BASEDIR))

If intFound > 0 Then
   objFileLog.WriteLine Now()
   objFileLog.Close
Else
   '=== Close LOGFILE
   objFileLog.Close
   Set objFileLog = objFS.GetFile(gLogFile)
   objFileLog.Delete
   gLogFile = LOGFILE2 & tCompName & ".log"
   Set objFileLog = objFS.OpenTextFile(gLogFile, ForAppending, True)
   objFileLog.WriteLine Now()
   objFileLog.Close
End If
      
Set objShell = CreateObject( "WScript.Shell" )
Set objFS = Nothing
Set objNetwork = Nothing
WScript.Quit

'------------------------------------------------------------------------------------------
'FindFiles(objFolder)
'
'Purpose: Finds files in Folder that are larger than maxSize
'------------------------------------------------------------------------------------------
Function FindFiles(objFolder)
 
   '=== Varibles with local scope
   Dim objMyFile
   Dim objMyFiles
   Dim objMyFolder
   Dim objMySubFolders
 
   FindFiles = 0
 
   '=== Get the collection of Folders in this folder
   Set objMySubFolders = objFolder.SubFolders
   '=== If there are subfolders, let process them first.
   If objMySubFolders.Count <> 0 Then
      For each objMyFolder in objMySubFolders
 
         '===== CHECK TO EXCLUDE CERTAIN FOLDERS?  WINDOWS, PROGRAM FILES
         If Not dicExcludedFolders.Exists(objMyFolder.Path) Then
            FindFiles = FindFiles + FindFiles(objMyFolder)
         End If
      Next
   End If
 
   '=== Get the collection of Files in this folder
   Set objMyFiles = objFolder.files
 
   If objMyFiles.Count <> 0 Then
      For Each objMyFile in objMyFiles
 
         '===== Check the file's extension against all of the extensions listed at top of script
         '===== Only do the Log creation if the extension matches
         If dicIncludedExtensions.Exists(objFS.GetExtensionName(objMyFile)) Then
            tOutput = pusername & "," & objMyFile.path & "," & "," & objMyFile.DateLastModified
            objFileLog.WriteLine tOutput
            FindFiles = FindFiles + 1
         End If      
      Next
   End If
End Function

Δ [email me]

Δ Wednesday, June 6th, 2012

Δ Create Simple Event log

How to create a log

[download resource files]

Pretty self-explanatory, it creates an application event log.

Δ [email me]

Δ Tuesday, June 5th, 2012

Δ Compare WMI Device IDs

How to compare WMI

[download resource files]

This could be used to identify whether a device is connected or not connected to a PC. Then you could
perform certain functions based on the returned information.

Δ [email me]

Δ Monday, June 4th, 2012

Δ Stop Java Pop-ups

How to stop annoying java pop-ups

[download resource files]

Are you tired of Java pop-ups annoying you and your customers? Well do something about it. You will
still need to update Java occassionally :-)

Δ [email me]

Δ Saturday, June 2nd, 2012

Δ Simulate Left Mouse Click

How to script a mouse click

[download resource files]

Demo

Do you need to simulate a mouse click? Ever need to just push the left click button to complete a
mundane task over and over again? Now you can. You can even move the cursor to an exact coordinate
on the screen before pressing the left click.

Δ [email me]

About

   I'm a Computer
   Systems Engineer

   Living and Loving Life

Author