How to Retieve data of an( .ini/.txt/.vbs) file using VBScript based on key-value pair

Class ReadInifile
Dim arrFile()
Dim objFSO, objFile
Function sec_prop(section_name,section_property)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("dataexg.ini", 1)
Do Until objFile.AtEndOfStream
str_sec = objFile.ReadLine
If str_sec = "["& section_name & "]" Then
svalue = ""
Do until InStr(svalue,"[") Or objFile.AtEndOfStream
Redim Preserve arrFile(0)
'MsgBox section_name & section_property
If Not objFile.AtEndOfStream Then
arrFile(0) = objFile.ReadLine
'MsgBox InStr(arrFile(0),section_property)
If InStr(arrFile(0),section_property) Then
a = Split(arrFile(0),"=")
sec_prop = a(1)
end If
svalue = arrFile(0)
End If
Loop
End If
Loop
Erase arrFile
objFile.close
End function
End Class

Dim objINI, Result
Set objINI = New ReadInifile
Result = objINI.sec_prop( "server","servername")
MsgBox Result

Program to send E-mail through VBScript

Function SendMail(SendTo, Subject, Body, Attachment)
Set ol=CreateObject("Outlook.Application")
Set Mail=ol.CreateItem(0)
Mail.to=SendTo
Mail.Subject=Subject
Mail.Body=Body
If (Attachment <> "") Then
Mail.Attachments.Add(Attachment)
End If
Mail.Send
Set Mail = Nothing
Set ol = Nothing
End Function
Call SendMail(("adityajoy58@gmail.com;kalyan_kudapa@adp.com"),"hi","HI This is Aditya","") //

How to Get Free space/Total space of Given Drive using VBScript

Dim a,s,t
Call GetFreeSpace("C:")
Wscript.echo s
Function GetFreeSpace(drvPath)
dim fs, d
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(drvPath))
s = "Drive " & drvPath & " - "
s = s & d.VolumeName
s = s & " Free Space: " & d.FreeSpace/1024 & " Kbytes"
s = s & " Total Space: " & d.TotalSize/1024 & "Kbytes"
GetFreeSpace = s
'MsgBox s
End function

How to Open Internet Explorer with particular site using VBScript

Option Explicit

Dim objIE
Set objIE = CreateObject("InternetExplorer.Application")

With objIE
.Visible = True
.FullScreen = False
.Navigate "http://www.igoogle.com/"
Do Until .ReadyState <> 4
WScript.Sleep 10000
Loop
End With

Set objIE = Nothing

How to Open any Windows Application using Vbscript

In this Program, we are opening a Windows calculator

set oShell = WScript.CreateObject("WScript.Shell")
oShell.Run "calc"
WScript.Sleep 10000
oShell.AppActivate "Calculator"
MsgBox ScriptEngineBuildVersion //For knowing which Script Engine we are using.

How to Open a Windows Application using Vbscript Program

In this Example, we are opening windows calculator

set oShell = WScript.CreateObject("WScript.Shell")
oShell.Run "calc"
WScript.Sleep 10000
oShell.AppActivate "Calculator"
MsgBox ScriptEngineBuildVersion // This line shows which version is the Script Engine in XP

Program to Create a shortcut of a file(.exe) using VBScript

'Creating a desktop icon

set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
set oShellLink = WshShell.CreateShortcut(strDesktop & "\Shortcut Script.lnk")
oShellLink.TargetPath = WScript.ScriptFullName
oShellLink.WindowStyle = 1
oShellLink.Hotkey = "CTRL+SHIFT+F"
oShellLink.IconLocation = "notepad.exe, 0"
oShellLink.Description = "Shortcut Script"
oShellLink.WorkingDirectory = strDesktop
oShellLink.Save

Program to Handle windows Processes and kill when required using VBScript.

FriendZ this is to maintain the windows processes with out own logic without bothering with self -scheduling windows tasks.

sComputer ="."
Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\CIMV2")
Object_OnTimer7510
Sub Object_OnTimer7510
sTotalHandle = 0
sTotalThread = 0
Set oWin32_OS = oWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each oItem In oWin32_OS
'sTotalHandle= oItem.TotalHandle
sFreePhysicalMemory = oItem.FreePhysicalMemory
sFreeVirtualMemory = oItem.FreeVirtualMemory
sTotalProcesses = oItem.NumberOfProcesses
sTotalVirtualMemorySize = oItem.TotalVirtualMemorySize
sTotalVisibleMemorySize = oItem.TotalVisibleMemorySize
Next
sSystemCache = sTotalVisibleMemorySize - sFreePhysicalMemory
sCommitLimit = sTotalVirtualMemorySize - sTotalVisibleMemorySize
text1= VbCrLf & "sTotalHandle :" & Space(16-Len(sTotalHandle))& sTotalHandle & VbCrLf & "sTotalThread :" & Space(16-Len(sTotalThread)) & sTotalThread & VbCrLf & "sTotalProcesses :" & Space(16-Len(sTotalProcesses)) & sTotalProcesses & VbCrLf & "sTotalVisibleMemorySize:" & Space(16-Len(sTotalVisibleMemorySize)) & sTotalVisibleMemorySize & VbCrLf & "sFreePhysicalMemory:" & Space(16-Len(sFreePhysicalMemory)) & sFreePhysicalMemory & VbCrLf & "sSystemCache :" & Space(16-Len(sSystemCache)) & sSystemCache & Space(16) & VbCrLf & "sCommitLimit :" & Space(16-Len(sCommitLimit)) & sCommitLimit & Space(16)
MsgBox text1
set servicelist = oWMI.ExecQuery("Select * from Win32_Process")
For Each service in servicelist
sname = sname & service.ProcessId & ":" & lcase(service.name) & Space(1)
'MsgBox service.name
Next
MsgBox sname
xml_file = InputBox("Enter which file you have to termimate :")
flag=True
For Each service in servicelist
If service.name = xml_file Then
service.Terminate()
flag= false
End if
Next
If flag then
MsgBox "File Name dose not exist"
Else
MsgBox xml_file & " process terminated"
End If
Set oWMI = Nothing
Set oWin32_OS = Nothing
Set servicelist = Nothing
End Sub

Program to copy data from MS excel to a text file at particular location using VBScript

Dim objExcel, objFile, objFSO, objFolder
strFolder = "\\10.6.2.58\Waves\Documents\TeamInformation\Eshwari"
strFile = "\datafromexcel.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder(strFolder)
Set objFile = objFSO.CreateTextFile(strFolder & strFile)
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("W:\Documents\TeamInformation\BirthdayInfo.xls")
intRow = 2
Do Until objExcel.Cells(intRow,1).Value = ""
objFile.Write(objExcel.Cells(intRow, 1).Value & " ")
objFile.WriteLine(objExcel.Cells(intRow, 2).Value)
intRow = intRow + 1
Loop
objFile.Close
objExcel.Quit

Copy a list of files specified in an Excel Sheet from one location to another location using VBscript

'This function is used to copy a list of files specified in an Excel Sheet from

'Declaration Section
Dim sExcelFile, sSource , sDestination
sExcelFile = "C:\Documents and Settings\BanduvvE\Desktop\fileslist.xls"
sSource = "D:\MyFiles\Generaldocs\"
sDestination = "D:\myfilecopy\"

'Calling a function which copies files specified in the Excel sheet from source to destination
call CopyFiles(sExcelFile, sSource, sDestination)


'Implementation or body of "copyfiles" function
Function CopyFiles(ByVal sExcelPath, ByVal sSourcePath, ByVal sDestinationPath)

'Declaration of Function Variables
Dim objFSO ' Object type for FileSystemObject
Dim objFolder_ ' Object type for Folder Object
Dim objFileColl ' Object type for FilesCollection Object
Dim objExcel ' Object type for Excel application Object
Dim objWorkBook ' Object type for Excel Workbook Object
Dim sFilePath 'Variable which stores the path of the file to be copied
Dim iExcelRow 'Variable which stores the count of rows in the ExcelSheet
Dim iFileCount 'Variable which stores the count of files that are copied to the destination folder
Dim sFileName 'Variable which stores the path of each file accessed thru FilesCollection Object

'Creating instances for objects which are used in this function
Set objExcel = CreateObject("Excel.Application") 'Create instance for the Excel Application
Set objWorkBook = objExcel.Workbooks.Open(sExcelPath) 'Create instance for the Workbook which was opened thru Excel Application
Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create instance for the FileSystemObject
Set objFolder = objFSO.GetFolder(sSourcePath) 'Create instance for Folder object to access the source folder
Set objFileColl = objFolder.Files 'Create instance for FilesCollection Object to access files retrieved by that object

'Initialization of required variables
iExcelRow = 2
iFileCount = 2

'Main part of the function implementation
While objExcel.Cells(iExcelRow, 1).Value <> "" 'This loop is used to read the data from the Excel Sheet row by row
'Excel Sheet has only filenames and we need the whole path for each file
'So concatenate the source folder path with the filename retrieved from the Excel sheet.
sFilePath = sSourcePath & objExcel.Cells(iExcelRow, 2).Value 'sFilePath has the filename with full path
'This loop reads each file from the FilesList returned by the FilesCollection Object
For Each sFileName in objFileColl 'For Each Loop can be used only for accessing individual objects from a collection
If sFileName = sFilePath Then 'Comparing the filename from the ExcelSheet with the filename from the fileslist
'CopyFile function is used to copy a file from current location to another location
'This function has 3 arguments -- filename to be copied, to which location it has to be copied and should overwrite if that file already exists
objFSO.CopyFile sFileName, sDestinationPath, True
iFileCount = iFileCount + 1 'Incrementing the filecount once that file is copied
End If
Next
iExcelRow = iExcelRow + 1 'Incrementing the Excel sheet row count
Wend 'End of the loop
If iExcelRow = iFileCount then
MsgBox "All Files Copied Successfully into the folder -- " & sDestinationPath
End If

'Closing the Excel Application
objExcel.Quit

'End of the function implementation
End Function

How to get the parent node of the given node in XML using VBscript?

Actually this program i have written with the help of functions in VBscript .... so try to analyse it carefully....

Dim snode_name,xml_file
xml_file = InputBox("Enter xml file")
'snode_name = InputBox("Enter Any Node")
Call xmltoexcel(xml_file)


Function xmltoexcel(xmlfile)
Dim i,j,snode_name
i=2
j=2
Set xlApp = CreateObject("Excel.Application")
xlApp.visible = true
Set objWorkbook = xlApp.Workbooks.Add("C:\Documents and Settings\BhavanaA\Desktop\VBscript\Book3.xls")
set xmlDoc=CreateObject("Microsoft.XMLDOM")
xmlDoc.load(xmlfile)
Call displaynode(xmlDoc.documentElement,xlApp,i)
snode_name = InputBox("Enter Any Node")
Call specific_node(xmlDoc.documentElement,xlApp,j,snode_name)

'objWorkbook.close
'xlApp.quit
End Function


Function displaynode(ByVal node_name,ByRef xlApp,Byref i )

xlApp.Range("A" & 1).Value="NODENAME"
xlApp.Range("B" & 1).Value="DATA"
xlApp.Range("C" & 1).Value="PARENTNODE"
xlApp.Range("A" & i).Value = node_name.nodename
xlApp.Range("B" & i).Value = ""
xlApp.Range("C" & i).Value = node_name.parentnode.nodename
For each cnt in node_name.childNodes
If cnt.HasChildNodes Then
i=i+1
Call displaynode(cnt,xlApp,i)
Else
xlApp.Range("B" & i).Value = cnt.text
xlApp.Range("C" & i).Value = cnt.parentnode.parentnode.nodename
End If
Next
End Function

Function specific_node(ByVal node_name,ByRef xlApp,ByRef j,snode_name)
xlApp.Range("H" & j).Value = node_name.nodename
'MsgBox iNode.nodename
If node_name.HasChildNodes Then
For Each sChildNode In node_name.ChildNodes
If sChildNode.HasChildNodes then
j=j+1
Call specific_node(sChildNode,xlApp,j,snode_name)
Else
xlApp.Range("I" & j).Value = sChildNode.parentnode.nodename
xlApp.Range("J" & j).Value = sChildNode.text
End if
Next
End If
If snode_name = node_name.nodename Then
Wscript.echo "My parent is " & node_name.parentnode.nodename
If node_name.HasChildNodes Then
get_nodelist(node_name)
End If
End If
End Function

Function get_nodelist(snode)
For Each strnode In snode.ChildNodes
If strNode.HasChildNodes then
snode_list = snode_list & "--->"& strnode.parentnode.nodename
Call get_nodelist(strnode)

End If
Next
Wscript.echo snode_list
End Function


Any QUES fEEL FREE TO ASK
Here is my email- id : aditya_joy58@yahoo.co.in

Program in VBscript for XML parser

Friendz,

I have written a program which actually parses XML into Excel(in my application)

the output will be like

Nodename Value Parentnode


Dim xml_file
xml_file = InputBox("Enter xml file")
Call xmltoexcel(xml_file)

Function xmltoexcel(xmlfile)
Dim i
i=1
Set xlApp = CreateObject("Excel.Application")
xlApp.visible = true
Set objWorkbook = xlApp.Workbooks.Add("C:\Documents and Settings\BhavanaA\Desktop\VBscript\Book3.xls")
set xmlDoc=CreateObject("Microsoft.XMLDOM")
xmlDoc.load(xmlfile)
For j = 1 To 4
xlApp.Worksheets(1).Cells(1, j).Interior.color = 10092543
Next
xlApp.Range("A" & 1).Value="NODENAME"
xlApp.Range("B" & 1).Value="DATA"
xlApp.Range("C" & 1).Value="PARENTNODE"

xlApp.Worksheets(1).Cells.Range("A1:C1").ColumnWidth = 35
Call displaynode(xmlDoc.documentElement,xlApp,i)
objWorkbook.close
xlApp.quit
End Function

Function displaynode(ByVal node_name,ByRef xlApp,Byref i )
i=i+1
xlApp.Range("A" & i).Value = node_name.nodename
xlApp.Range("B" & i).Value = ""
xlApp.Range("C" & i).Value = node_name.parentnode.nodename
j=0
for each cnt in node_name.childNodes
if cnt.HasChildNodes Then
Call displaynode(cnt,xlApp,i)
Else
If (j>0)Or (j=0 And cnt.nodename<>"#text") Then
i=i+1
xlapp.Range("A" & i).value = cnt.nodename
xlApp.Range("C" & i).Value = cnt.parentnode.nodename
End If
xlApp.Range("B" & i).Value = cnt.text
end If
j=j+1
Next
End Function

How to copy data from (database,Txt file.....) to specified sheet(say sheet 1|sheet2|sheet3|sheet4) in the Excel workbook

Dim xlApp
Dim xlBook
Dim xlSheet
Dim conn,rs,sql,strConnect
Dim objWorkbook
Dim colSheets
Dim ws
Set conn=CreateObject("ADODB.Connection")
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\BhavanaA\Desktop\VBscript\OFFICE.mdb"
conn.Open strConnect
sql="SELECT * FROM OF_MT_USERINFO"
Set rs=conn.execute(sql)
Set xlApp = CreateObject("Excel.Application")
xlApp.visible = True
xlApp.SheetsInNewWorkbook=8
Set wbs=xlApp.Workbooks
'Set objWorkbook = xlApp.Workbooks.Add
wbs.add
Set objWorkbook=xlApp.Worksheets
Set ws=objWorkbook.Item(4)
ws.Activate

i=3
While not rs.EOF
xlApp.Range("A" & i).Value = rs("USR_LoginID")
xlApp.Range("B" & i).Value = rs("USR_Password")
xlApp.Range("C" & i).Value = rs("USR_Name")
xlApp.Range("D" & i).Value = ("USR_Role")
rs.MoveNext
i = i + 1
Wend


xlApp.quit

How to Copy data from Database to Excel sheet ?

Dim xlApp
Dim xlBook
Dim xlSheet
Dim conn,rs,sql,strConnect
Dim objWorkbook
Dim colSheets
Set conn=CreateObject("ADODB.Connection")
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\BhavanaA\Desktop\VBscript\OFFICE.mdb"
conn.Open strConnect
sql="SELECT * FROM OF_MT_USERINFO"
Set rs=conn.execute(sql)
Set xlApp = CreateObject("Excel.Application")
xlApp.visible = true
Set objWorkbook = xlApp.Workbooks.Add("C:\Documents and Settings\BhavanaA\Desktop\VBscript\Book1.xls")
Set objWorksheet = objWorkbook.Worksheets(3)
Set colSheets = objWorkbook.Sheets
colSheets.Add ,objWorksheet,9
Set xlSheet = objWorkbook.Worksheets(9)
xlSheet.Activate
i=3
While not rs.EOF
xlApp.Range("A" & i).Value = rs("USR_LoginID")
xlApp.Range("B" & i).Value = rs("USR_Password")
xlApp.Range("C" & i).Value = rs("USR_Name")
xlApp.Range("D" & i).Value = ("USR_Role")
rs.MoveNext
i = i + 1
Wend
objWorkbook.close
xlApp.quit