Setup Global Variable for Path
Method# 1 Set WshShell = CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("Process")
sWinDir = WshSysEnv("WINDIR")
sWinDir = sWinDir+"\OptionValidation.ini"
Note: OptionValidation.ini this is a ini file should be created and stored in C:\. The file should contain directory of working folder for script
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(sWinDir,1)
ProjDir = ts.ReadLine
ts.Close
Method# 2
Set WshShell = CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
ProjDir = strDesktop&"\"&"Folder name in desktop"
_________________________________________________________________
Create Excel Objects
Set ExcelObj = CreateObject("Excel.Application") Excelobj.visible = True
ExcelObj.Workbooks.Open
Set WorkSheetAct = ExcelObj.ActiveSheet
Retrieve Value from Excel
Set Mail=ol.CreateItem(0)
Mail.to =
Mail.Subject="Test Results For : "
If (Attachment <> "") Then
Mail.Attachments.Add(
End If
Mail.Send
ol.Quit
Server_Name = "Server name database is available"
User_Id = " User id "
Pass_Word = "Password"
Query_String = "Query you want to execute"
Set con=Createobject("ADODB.Connection") 'Creates the connection object
Set rs=Createobject("ADODB.recordset") 'Creates a resultset
rs.CursorLocation = 3
rs.CursorType =3
con.connectionstring= "Driver={"&Driver_Name&"};Server="&Server_Name&";Database="&Database_Name&";Uid="&User_ID&";Pwd="&Pass_Word&";"
con.CommandTimeout = 7000
con.open 'connSTR 'Opens the connection
strSQL=Query_String 'Querry string
rs.open strSQL, con 'Executes the querry
Set DatabaseConnection = rs 'Returns the result set
If reTable.recordcount>0 Then 'Checks if there are rows in recordSet
For x=1 to reTable.recordcount
Set DT = CreateObject("Excel.Application")
DT.visible = True
Set ab = DT.Workbooks.Open(ProjDir&"\File.xls")
abc= 2
st2 = Len(Str)
Do while ( ab.Worksheets(1).cells(abc,16).value <> "EOD")
For j = 1 to st2-len( ab.Worksheets(1).cells(abc,16).value)+1
mystring = Mid(Str,j,Len( ab.Worksheets(1).cells(abc,16).value))
If lcase(mystring) = LCase(ab.Worksheets(1).cells(abc,16).value) Then
Stlen = lcase(mystring)
Checked = "True"
exit for
end if
Next
If Checked = "True" Then
Exit Do
else
abc = abc+1
End If
Loop
'Next
If Checked <> "True" Then
abc= 2
Do while ( ab.Worksheets(1).cells(abc,3).value <> "EOD")
For j = 1 to st2-len( ab.Worksheets(1).cells(abc,3).value)+1
mystring = Mid(Str,j,Len( ab.Worksheets(1).cells(abc,3).value))
If LCase(Trim(mystring)) = LCase(ab.Worksheets(1).cells(abc,3).value) Then
Stlen = mystring
Checked = "True"
exit for
end if
Next
If Checked = "True" Then
Exit Do
else
abc = abc+1
end if
Loop
End If
ab.close
DT.Quit
Set DT = Nothing
End Function
Function Stlen2(ProjDir,Str)
Set DT = CreateObject("Excel.Application")
DT.visible = True
Set ab = DT.Workbooks.Open(ProjDir&"\HFile.xls")
abc= 2
st2 = Len(Str)
Do while ( ab.Worksheets(1).cells(abc,17).value <> "EOD")
For j = 1 to (st2-len(ab.Worksheets(1).cells(abc,17).value))+1
mystring = Mid(Str,j,Len( ab.Worksheets(1).cells(abc,17).value))
If lcase(trim(mystring)) = lcase(trim(ab.Worksheets(1).cells(abc,17).value)) Then
Stlen2 = lcase(mystring)
Checked = "True"
exit for
end if
Next
If Checked = "True" Then
Exit Do
else
abc = abc+1
End If
Loop
ab.close
DT.Quit
Set DT = Nothing
End Function
stlen = Len(Str)
for i = 1 to stlen
mystring = Mid(Str,i,1)
If mystring = "(" then
mystring2 = Mid(Str,i,stlen)
If i >20 Then
mystring1 = mid(Str,1,20)
else
mystring1 = mid(Str,1,i-4)
End If
'msgbox(mystring2)
exit for
end if
Next
Stlen = mystring1&mystring2
End Function
___________________________________________________________________________
Excelobj.visible = True
ExcelObj.Workbooks.Open "C:\File1.xls"
ExcelObj.ActiveWorkbook.saveas "C:\File1.csv",6
ExcelObj.Quit
Set ExcelObj = Nothing
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile("C:\Documents and Settings\mallik\Desktop\test\testfile_"&i&".xml", True)
MyFile.WriteLine("")
MyFile.WriteLine ("
MyFile.WriteLine("
MyFile.Close
next