Pick_File Function_Modified

Pick_File Function_Modified

(Hibernation Script + Reiterating + Reporter Event Added)

Call Pick_modified()　

Public Function Pick_modified()

Dim f1

Set fso = CreateObject("Scripting.FileSystemObject")

strPendingFolder =　 "

\\tstgnpappw001\IVS_ Automation\Project THOR\Incoming\"

strResponseFileFolder= "\\tstgnpappw001\IVS_ Automation\Project THOR\Outgoing\"

　　　　　　　　　　
If　fso.FolderExists(strPendingFolder) Then

　　　　　Set fileList = fso.GetFolder(strPendingFolder).Files

　　　 　　filecount = fileList.Count

　　　　　　 If　 filecount = 0 Then

　　　　　　　 　waiting_time = 2

　　　　　    　 　Final_wait_time = waiting_time*60

　　　　　　　 　Wscript.Sleep (Final_wait_time)

　　　　　　　     Call Stop_Hibernation(waiting_time)

　　　　　　　　Call Pick_modified()

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 'Reporter.ReportEvent micWarning,"No Files Present in　 Incomming Folder","Files not found in

\\tstgnpappw001\IVS_ Automation\Project THOR\Incoming\　　　 location"

　　　　　    End If

　　　Else

　　　 'Create the folder

　　　set filesys=CreateObject("Scripting.FileSystemObject")

　　　Set newfolder = filesys.CreateFolder(strPendingFolder)

　　　Call Pick_modified()　 　　　　　　　　　　　　　　　　　　　　　 　　　

'　　　ExitRun

　End If

　
　　 For Each f1 in fileList

　　　　　　　　　　　　 filename=　 f1.name

　　　　　　　　　　　　 filetime = f1.DateCreated

　　　　　　　　　　　　 new_line　 = split(filetime," ")

　　　　　　　　　　　　 date_revised = split(new_line(0),"/")

　　　　　　　　　　　　 new_date=date_revised(0)&date_revised(1)&date_revised(2)

　　　　　　　　　　　　 time_revised = split(new_line(1),":")

　　　　　　　　　　　　 new_time = time_revised(0)&time_revised(1)&time_revised(2)

　　　　　　　　　　　　final_output_creationtime = new_date&new_time

　　　　　　　　　　　　 collective_filename = collective_filename&"-"&filename

　　　　　　　　　　　　 saveme = saveme&"_"&final_output_creationtime

　　 　                                    excel_file =　 filename&";"&final_output_creationtime

　　　　　　　　　　　　bundle_excel = bundle_excel&"-"&excel_file

　　　　　　　　　　　　'msgbox excel_file

　　　　　　　　　　　　'msgbox bundle_excel

　　Next

　　　　　　　　　　　　　　　

　　split_bundle = split(bundle_excel,"-")

　　split_filetime = split(saveme, "_")

　　split_filename = split(collective_filename,"-")

　　refernce_file = split_filetime(1)

　　For i = 1 to ubound(split_filetime)

　　　 If　 refernce_file > split_filetime(i)Then

　　  　　 refernce_file = split_filetime(i)

'　　 　　 reference_filename = split_filename(i)

　　　 Else

　　     　 reference_filename = split_filename(i)

　　　End If

　  Next

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 For i = 1 to ubound(split_bundle)

　 If Instr(1,split_bundle(i),refernce_file,1) Then

　　　 split_Move_file = split(split_bundle(i),"-")

　         Move_File = split_Move_file(0)

　　　Final_Move_File = split(Move_File,";")

　End If

Next

　　　　　　　　　　　　　　　　　　　　　　　　　　　

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFile(strPendingFolder & "\" & Final_Move_File(0) )

 fso.MoveFile　 f,strResponseFileFolder

End Function

'******************Hibernate Function******

Public Function Stop_Hibernation(waiting_time)

　　　 yourVariable = DateAdd("n",waiting_time,Time())

    　　 msgbox yourVariable

　    　 Do Until (time() = yourVariable)

　　　                set wsc = CreateObject("WScript.Shell")

　　                    wsc.SendKeys ("{SCROLLLOCK 2}")

　　　Loop

　　　Wscript.Quit

End Function　　

'****************************************

　

　

Compare the Files based on Date Modified and Move the file with earlier timestamp to a specified folder

Compare the Files based on Date Modified and Move the file with earlier timestamp to a specified folder

(Added the reporter event.. + File exists Check)

　

Dim f1

Set fso = CreateObject("Scripting.FileSystemObject")

strPendingFolder =　 "

\\tstgnpappw001\IVS_ Automation\Project THOR\Incoming\"

strResponseFileFolder= "\\tstgnpappw001\IVS_ Automation\Project THOR\Outgoing\"

　　　　　　　　　　　　　　　
If fso.FolderExists(strPendingFolder) Then

　 Set fileList = fso.GetFolder(strPendingFolder).Files

　 filecount = fileList.Count

　　　 If　 filecount = 0 Then

　 Reporter.ReportEvent micWarning,"No Files Present in　 Incomming Folder","Files not found in

\\tstgnpappw001\IVS_ Automation\Project THOR\Incoming\　　　 location"

　　　　   ExitRun　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　             End If
Else

   Reporter.ReportEvent micWarning,"No Incomming Folder Present ","Incoming Folder not found in

\\tstgnpappw001\IVS_ Automation\Project THOR\"

　ExitRun

End If

For Each f1 in fileList

 　 filename=　 f1.name

 　 filetime = f1.DateCreated

　  new_line　 = split(filetime," ")

     date_revised = split(new_line(0),"/")

　 new_date=date_revised(0)&date_revised(1)&date_revised(2)

　 time_revised = split(new_line(1),":")

　 new_time = time_revised(0)&time_revised(1)&time_revised(2)

　final_output_creationtime = new_date&new_time

　collective_filename = collective_filename&"_"&filename

　saveme = saveme&"_"&final_output_creationtime

Next

 split_filetime = split(saveme, "_")

 split_filename = split(collective_filename,"_")

 For i = 1 to ubound(split_filetime)

　 refernce_file = split_filetime(1)

          If　 refernce_file > split_filetime(i)Then

　　　     refernce_file = split_filetime(i)

　　　　 reference_filename = split_filename(i)

　　  End If

Next

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFile(strPendingFolder & "\" & reference_filename )

fso.MoveFile　 f,strResponseFileFolder

　

Revised SMTP Code which Takes Arguments

Revised SMTP Code which Takes Arguments 

WebForm_Ref_ID = "AAAGZ001"

Err_Message = "Login Failed"

Filename= "Ayaskant Jena"

Failtype="Login"

Failcause="Incorrect Credentials"

Failwhen= "During Login"

　

Call Mail_Trigger(WebForm_Ref_ID,Err_Message,Filename,Failtype,Failcause,Failwhen)

Public Function Mail_Trigger(WebForm_Ref_ID,Err_Message,Filename,Failtype,Failcause,Failwhen)

　　Set objEmail = CreateObject("CDO.Message")

　　 new_date = split(date,"/")

　　 new_time = split(time,":")　　　　　　　　　　

　　Timestamp = "<"&new_time(0)&new_time(1)& new_time(2)&"_" &new_date(0)&new_date(1)&new_date(2)&">"

　　
'This field defines whether to send the message using the local SMTP service drop directory

objEmail.Configuration.Fields.Item _

("

http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'This field defines the smtp server address of optus.com.au

objEmail.Configuration.Fields.Item _

("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "CHOW2KE001.optus.com.au"

'This field defines the smtp server port of optus.com.au

objEmail.Configuration.Fields.Item _

("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 objEmail.Configuration.Fields.Update

objEmail.From = "Project_Thor_Error_Messaging_Service"

objEmail.To = "Ayaskant.Jena;Ravi.tesh"

objEmail.Subject = "Error Messaging Service For Order Reference Number _"&WebForm_Ref_ID

Footer_Details =vbCrlf & vbCrlf &"*********************************************************************************************************" & vbcrlf & "This is an auto-generated email. Please do not reply to this email." & vbcrlf &"*********************************************************************************************************"

Header_Details =　 "Hi All," & vbcrLf & vbCrlf & "Please find the error message details below:" & vbcrLf & vbCrlf

objEmail.Textbody = Header_Details &Timestamp&"_"&Filename&"_"&WebForm_Ref_ID&"_"&Failtype&"_"&Failcause&"_"&Failwhen &vbCrlf & Footer_Details

objEmail.Send

End Function

Convert .CSV file to Excel File(.xls)(1997-2003) with Proper Formating Using VB Script

Convert .CSV file to Excel File(.xls)(1997-2003) with Proper Formating Using VB Script

Dim objXLApp, objXLWb, objXLWs

Set objXLApp = CreateObject("Excel.Application")

objXLApp.Visible = False

Set objXLWb = objXLApp.Workbooks.Open ("C:\Documents and Settings\Ayaskant Jena\Desktop\OPOM_NBN_Original_1.csv")

'~~> Save as Excel File (xls) to retain format

objXLWb.SaveAs "C:\Documents and Settings\Ayaskant Jena\Desktop\OPOM_NBN.xls", 56

Set ExcelObject = CreateObject("Excel.Application")

ExcelObject.visible = False

ExcelObject.Workbooks.Open　 ("C:\Documents and Settings\Ayaskant Jena\Desktop\OPOM_NBN.xls")

intRowCount = ExcelObject.ActiveSheet.UsedRange.Rows.Count

intColumnCount = ExcelObject.ActiveSheet.UsedRange.Columns.Count

ExcelObject.Sheets(1).name = "MasterData"

objXLWb.Close (False)

Set ExcelObject = Nothing

Set objXLApp = Nothing

Sending Mail Via SMTP Server

Sending Mail Via SMTP Server

Set objEmail = CreateObject("CDO.Message")

objEmail.From = "

ummed.sindgh@optus.com.au"

objEmail.To = "

ayaskant.jena@optus.com.au"

objEmail.CC = "

adarsdh.venkatesh@optus.com.au"

objEmail.Subject = "Testing-project thor"

objEmail.Textbody = "Server1 is no longer accessible over the network."

objEmail.AddAttachment "C:\Documents and Settings\Ayaskant Jena\Desktop\BUOS_Updated_Friday.txt"

objEmail.Configuration.Fields.Item _

("

http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

objEmail.Configuration.Fields.Item _

("

http://schemas.microsoft.com/cdo/configuration/smtpserver") = "CHOW2KE001.optus.com.au"

objEmail.Configuration.Fields.Item _

("

http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

objEmail.Configuration.Fields.Update

objEmail.Send

To Zip the folder and delete the files present in it..

To Zip the folder and delete the files present in it..

myFolder = "C:\Documents and Settings\Ayaskant Jena\Desktop\Source Folder"

myZipFile = "C:\Documents and Settings\Ayaskant Jena\Desktop\Source Folder\" &"Output_File_"

'msgbox myZipFile

Call ZipFolder( myFolder, myZipFile )

　

　

　

Function ZipFolder( myFolder, myZipFile )

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 new_date = split(date,"/")

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 new_time = split(time,":")　　　　　　　　　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 now_latest = new_time(0)&new_time(1)& new_time(2)&"_" &new_date(0)&new_date(1)&new_date(2)

　　　　　　　　　　　　　　　 myZipFile = myZipFile &now_latest &".zip"

'　　　　　　　　　　　　　　 msgbox myZipFile

　　　 Dim intSkipped, intSrcItems

　　　 Dim objApp, objFolder, objFSO, objItem, objTxt

　　　 Dim strSkipped

　　　 Const ForWriting = 2

　　　 intSkipped = 0

　　　 If Right( myFolder, 1 ) <> "\" Then

　　　　　　　 myFolder = myFolder & "\"

　　　 End If

　　　 On Error Resume Next

　　　 Set objFSO = CreateObject( "Scripting.FileSystemObject" )

　　　　　　　　　　　　　　　

　　　　　　　　　　　　　　　 If　 objFSO.FileExists(myZipFile)Then

　　　　　　　 objFSO.DeleteFile myZipFile, True

　　　　　　　　　　　　　　　 End If

　　　　　　　　　　　　　　　

　　　 Set objTxt = objFSO.OpenTextFile( myZipFile, ForWriting, True )

　　　 objTxt.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )

　　　 objTxt.Close

　　　 Set objTxt = Nothing

　If Err Then

　　　　　　　 ZipFolder = Array( Err.Number, Err.Source, Err.Description )

　　　　　　　 Err.Clear

　　　　　　　 On Error Goto 0

　　　　　　　 Exit Function

　　　 End If

　　　

　　　 Set objApp = CreateObject( "Shell.Application" )

　　　 For Each objItem in objApp.NameSpace( myFolder ).Items

　　　　　　　 If objItem.IsFolder Then

　　　　　　　　　　　 Set objFolder = objFSO.GetFolder( objItem.Path )

　　　　　　　　　　　 If objFolder.Files.Count + objFolder.SubFolders.Count = 0 Then

　　　　　　　　　　　　　　　 intSkipped = intSkipped + 1

　　　　　　　　　　　 Else

　　　　　　　　　　　　　　　 objApp.NameSpace( myZipFile ).CopyHere objItem

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 '　　　　　　　　　　　　　　 msgbox objItem

　　　　　　　　　　　 End If

　　　　　　　 Else

　　　　　　　　　　　 objApp.NameSpace( myZipFile ).CopyHere objItem

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 'msgbox objItem

　　　　　 End If

　　　 Next

wait(10)

msgbox "okok"

Set objApp = CreateObject( "Shell.Application" )

　　　 For Each objItem in objApp.NameSpace( myFolder ).Items

　　　　　　 If objItem <> myZipFile Then

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 objFSO.deletefile ( "C:\Documents and Settings\Ayaskant Jena\Desktop\Source Folder\" & objItem & ".xls*")

　　　　　　　　　　　　　　　 End If

Next

　

　

　

　

　

　

　　　 Set objFolder = Nothing

　　　 Set objFSO　　　 = Nothing

　　　 ' Abort on errors

　　　 If Err Then

　　　　　　　 ZipFolder = Array( Err.Number, Err.Source, Err.Description )

　　　　　　　 Set objApp = Nothing

　　　　　　　 Err.Clear

　　　　　　　 On Error Goto 0

　　　　　　　 Exit Function

　　　 End If

　　　 ' Keep script waiting until compression is done

　　　 intSrcItems = objApp.NameSpace( myFolder　 ).Items.Count

　　　 Do Until objApp.NameSpace( myZipFile ).Items.Count + intSkipped = intSrcItems

　　　　　　　 WScript.Sleep 200

　　　 Loop

　　　 Set objApp = Nothing

　　　 ' Abort on errors

　　　 If Err Then

　　　　　　　 ZipFolder = Array( Err.Number, Err.Source, Err.Description )

　　　　　　　 Err.Clear

　　　　　　　 On Error Goto 0

　　　　　　　 Exit Function

　　　 End If

　　　 ' Restore default error handling

　　　 On Error Goto 0

　　　 ' Return message if empty subfolders were skipped

　　　 If intSkipped = 0 Then

　　　　　　　 strSkipped = ""

　　　 Else

　　　　　　　 strSkipped = "skipped empty subfolders"

　　　 End If

　　　 ' Return code 0 (no error occurred)

　　　 ZipFolder = Array( 0, intSkipped, strSkipped )

End Function

　

QTP Restart and Shutdown

QTP Restart and Shutdown

'*********Opens the QTP and Runs the specified Script******************

Dim App 'As Application

Set App = CreateObject("QuickTest.Application")

App.Launch

App.Visible = True

App.Folders.Add("C:\Documents and Settings\Ayaskant Jena\Desktop\Vinay.qfl")

App.Folders.Add("C:\Documents and Settings\Ayaskant Jena\Desktop\Repository1.tsr")

App.Open "C:\Documents and Settings\Ayaskant Jena\Desktop\Ayas",False

App.Test.Run

'*************************WORKING FINE********************************

　

'**********Discards the present test and Close QTP*********************

Dim App 'As Application

Set App = CreateObject("QuickTest.Application")

App.quit

Set App = nothing

'*************************WORKING FINE*********************************