QTP基础代码收集《二》

3、  使用qtp发mail
'  Example  1
    Function  SendMail(SendTo,  Subject,  Body,  Attachment)
    Set  ōl=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
    ol.Quit
    Set  Mail  =  Nothing
    Set  &#333;l  =  Nothing
    End  Function
   
    '  Example  2
    Function  SendMail(SendFrom,  SendTo,  Subject,  Body)
    Set  &#333;bjMail=CreateObject("CDONTS.Newmail")
    ObjMail.From  =  SendFrom
    ObjMail.To  =  SendTo
    ObjMail.Subject  =  Subject
    ObjMail.Body  =  Body
    ObjMail.Send
    Set  &#333;bjMail  =  Nothing
    End  Function 
4、Excel操作函数集合：
Dim  ExcellApp  'As  Excel.Application
    Dim  excelSheet1  'As  Excel.worksheet
    Dim  excelSheet2  'As  Excel.worksheet
   
    Set  ExcelApp  =  CreateExcel()
   
    'Create  a  workbook  with  two  worksheets
    ret  =  RenameWorksheet(ExcelApp,  "Book1",  "Sheet1",  "Example1  Sheet  Name")
    ret  =  RenameWorksheet(ExcelApp,  "Book1",  "Sheet2",  "Example2  Sheet  Name")
    ret  =  RemoveWorksheet(ExcelApp,  "Book1",  "Sheet3")
   
    'SaveAs  the  work  book
    ret  =  SaveWorkbook(ExcelApp,  "Book1",  "D:\Example1.xls")
   
    'Fill  worksheets
    Set  excelSheet1  =  GetSheet(ExcelApp,  "Example1  Sheet  Name")
    Set  excelSheet2  =  GetSheet(ExcelApp,  "Example2  Sheet  Name")
    For  column  =  1  to  10
    For  row  =  1  to  10
    SetCellValue  excelSheet1,  row,  column,  row  +  column
    SetCellValue  excelSheet2,  row,  column,  row  +  column
    Next
    Next
   
    'Compare  the  two  worksheets
    ret  =  CompareSheets(excelSheet1,  excelSheet2,  1,  10,  1,  10,  False)
    If  ret  Then
    MsgBox  "The  two  worksheets  are  identical"
    End  If
   
    'Change  the  values  in  on e  sheet
    SetCellValue  excelSheet1,  1,  1,  "Yellow"
    SetCellValue  excelSheet2,  2,  2,  "Hello"
   
    'Compare  the  worksheets  again
    ret  =  CompareSheets(excelSheet1,  excelSheet2,  1,  10,  1,  10,  True)
    If  Not  ret  Then
    MsgBox  "The  two  worksheets  are  not  identical"
    End  If
   
    'save  the  workbook  by  index  identifier
    SaveWorkbook  ExcelApp,  1,  ""
   
    'Close  the  Excel  application
    CloseExcel  ExcelApp
   
    '  ******************************************  Function  Library  ***********************************************************
Dim  ExcelApp  'As  Excel.Application
    Dim  excelSheet  'As  Excel.worksheet
    Dim  excelBook  'As  Excel.workbook
    Dim  fso  'As  scr&#299;pting.FileSystemObject
   
    '  This  function  will  return  a  new  Excel  Object  with  a  default  new  Workbook
    Function  CreateExcel()  'As  Excel.Application
    Dim  excelSheet  'As  Excel.worksheet
    Set  ExcelApp  =  CreateObject("Excel.Application")  'Create  a  new  excel  Object
    ExcelApp.Workbooks.Add
    ExcelApp.Visible  =  True
    Set  CreateExcel  =  ExcelApp
    End  Function
   
    'This  function  will  close  the  given  Excel  Object
    'excelApp  -  an  Excel  application  object  to  be  closed
    Sub  CloseExcel(ExcelApp)
    Set  excelSheet  =  ExcelApp.ActiveSheet
    Set  excelBook  =  ExcelApp.ActiveWorkbook
    Set  fso  =  CreateObject("scr&#299;pting.FileSystemObject")
    On  Error  Resume  Next
    fso.CreateFolder  "C:\Temp"
    fso.DeleteFile  "C:\Temp\ExcelExamples.xls"
    excelBook.SaveAs  "C:\Temp\ExcelExamples.xls"
    ExcelApp.Quit
    Set  ExcelApp  =  Nothing
    Set  fso  =  Nothing
    Err  =  0
    On  Error  GoTo  0
    End  Sub
   
    'The  SaveWorkbook  method  will  save  a  workbook  according  to  the  workbookIdentifier
    'The  method  will  overwrite  the  previously  saved  file  under  the  given  path
    'excelApp  -  a  reference  to  the  Excel  Application
    'workbookIdentifier  -  The  name  or  number  of  the  requested  workbook
    'path  -  the  location  to  which  the  workbook  should  be  saved
    'Return  "OK"  on  success  and  "Bad  Workbook  Identifier"  on  failure
    Function  SaveWorkbook(ExcelApp,  workbookIdentifier,  path)  'As  String
    Dim  workbook  'As  Excel.workbook
    On  Error  Resume  Next
    Set  workbook  =  ExcelApp.Workbooks(workbookIdentifier)
    On  Error  GoTo  0
    If  Not  workbook  Is  Nothing  Then
    If  path  =  ""  Or  path  =  workbook.FullName  Or  path  =  workbook.Name  Then
    workbook.Save
    Else
    Set  fso  =  CreateObject("scr&#299;pting.FileSystemObject")
   
    'if  the  path  has  no  file  extension  then  add  the  'xls'  extension
    If  InStr(path,  ".")  =  0  Then
    path  =  path  &  ".xls"
    End  If
   
    On  Error  Resume  Next
    fso.DeleteFile  path
    Set  fso  =  Nothing
    Err  =  0
    On  Error  GoTo  0
    workbook.SaveAs  path
    End  If
    SaveWorkbook  =  "OK"
    Else
    SaveWorkbook  =  "Bad  Workbook  Identifier"
    End  If
    End  Function
   
    'The  SetCellValue  method  sets  the  given  'value'  in  the  cell  which  is  identified  by
    'its  row  column  and  parent  Excel  sheet
    'excelSheet  -  the  excel  sheet  that  is  the  parent  of  the  requested  cell
    'row  -  the  cell's  row  in  the  excelSheet
    'column  -  the  cell's  column  in  the  excelSheet
    'value  -  the  value  to  be  set  in  the  cell
    Sub  SetCellValue(excelSheet,  row,  column,  value)
    On  Error  Resume  Next
    excelSheet.Cells(row,  column)  =  value
    On  Error  GoTo  0
    End  Sub
   
    'The  GetCellValue  returns  the  cell's  value  according  to  its  row  column  and  sheet
    'excelSheet  -  the  Excel  Sheet  in  which  the  cell  exists
    'row  -  the  cell's  row
    'column  -  the  cell's  column
    'return  0  if  the  cell  could  not  be  found
    Function  GetCellValue(excelSheet,  row,  column)
    value  =  0
    Err  =  0
    On  Error  Resume  Next
    tempValue  =  excelSheet.Cells(row,  column)
    If  Err  =  0  Then
    value  =  tempValue
    Err  =  0
    End  If
    On  Error  GoTo  0
    GetCellValue  =  value
    End  Function
   
    'The  GetSheet  method  returns  an  Excel  Sheet  according  to  the  sheetIdentifier
    'ExcelApp  -  the  Excel  application  which  is  the  parent  of  the  requested  sheet
    'sheetIdentifier  -  the  name  or  the  number  of  the  requested  Excel  sheet
    'return  Nothing  on  failure
    Function  GetSheet(ExcelApp,  sheetIdentifier)  'As  Excel.worksheet
    On  Error  Resume  Next
    Set  GetSheet  =  ExcelApp.Worksheets.Item(sheetIdentifier)
    On  Error  GoTo  0
    End  Function
   
    'The  InsertNewWorksheet  method  inserts  an  new  worksheet  into  the  active  workbook  or
    'the  workbook  identified  by  the  workbookIdentifier,  the  new  worksheet  will  get  a  default
    'name  if  the  sheetName  parameter  is  empty,  otherwise  the  sheet  will  have  the  sheetName
    'as  a  name.
    'Return  -  the  new  sheet  as  an  Object
    'ExcelApp  -  the  excel  application  object  into  which  the  new  worksheet  should  be  added
    'workbookIdentifier  -  an  optional  identifier  of  the  worksheet  into  which  the  new  worksheet  should  be  added
    'sheetName  -  the  optional  name  of  the  new  worksheet.
    Function  InsertNewWorksheet(ExcelApp,  workbookIdentifier,  sheetName)  'As  Excel.worksheet
    Dim  workbook  'As  Excel.workbook
    Dim  worksheet  'As  Excel.worksheet
   
    'In  case  that  the  workbookIdentifier  is  empty  we  will  work  on  the  active  workbook
    If  workbookIdentifier  =  ""  Then
    Set  workbook  =  ExcelApp.ActiveWorkbook
    Else
    On  Error  Resume  Next
    Err  =  0
    Set  workbook  =  ExcelApp.Workbooks(workbookIdentifier)
    If  Err  <>  0  Then
    Set  InsertNewWorksheet  =  Nothing
    Err  =  0
    Exit  Function
    End  If
    On  Error  GoTo  0
    End  If
   
    sheetCount  =  workbook.Sheets.Count
    workbook.Sheets.Add  ,  sheetCount
    Set  worksheet  =  workbook.Sheets(sheetCount  +  1)
   
    'In  case  that  the  sheetName  is  not  empty  set  the  new  sheet's  name  to  sheetName
    If  sheetName  <>  ""  Then
    worksheet.Name  =  sheetName
    End  If
   
    Set  InsertNewWorksheet  =  worksheet
    End  Function
   
    'The  RenameWorksheet  method  renames  a  worksheet's  name
    'ExcelApp  -  the  excel  application  which  is  the  worksheet's  parent
    'workbookIdentifier  -  the  worksheet's  parent  workbook  identifier
    'worksheetIdentifier  -  the  worksheet's  identifier
    'sheetName  -  the  new  name  for  the  worksheet
    Function  RenameWorksheet(ExcelApp,  workbookIdentifier,  worksheetIdentifier,  sheetName)  'As  String
    Dim  workbook  'As  Excel.workbook
    Dim  worksheet  'As  Excel.worksheet
    On  Error  Resume  Next
    Err  =  0
    Set  workbook  =  ExcelApp.Workbooks(workbookIdentifier)
    If  Err  <>  0  Then
    RenameWorksheet  =  "Bad  Workbook  Identifier"
    Err  =  0
    Exit  Function
    End  If
    Set  worksheet  =  workbook.Sheets(worksheetIdentifier)
    If  Err  <>  0  Then
    RenameWorksheet  =  "Bad  Worksheet  Identifier"
    Err  =  0
    Exit  Function
    End  If
    worksheet.Name  =  sheetName
    RenameWorksheet  =  "OK"
    End  Function
   
    'The  RemoveWorksheet  method  removes  a  worksheet  from  a  workbook
    'ExcelApp  -  the  excel  application  which  is  the  worksheet's  parent
    'workbookIdentifier  -  the  worksheet's  parent  workbook  identifier
    'worksheetIdentifier  -  the  worksheet's  identifier
    Function  RemoveWorksheet(ExcelApp,  workbookIdentifier,  worksheetIdentifier)  'As  String
    Dim  workbook  'As  Excel.workbook
    Dim  worksheet  'As  Excel.worksheet
    On  Error  Resume  Next
    Err  =  0
    Set  workbook  =  ExcelApp.Workbooks(workbookIdentifier)
    If  Err  <>  0  Then
    RemoveWorksheet  =  "Bad  Workbook  Identifier"
    Exit  Function
    End  If
    Set  worksheet  =  workbook.Sheets(worksheetIdentifier)
    If  Err  <>  0  Then
    RemoveWorksheet  =  "Bad  Worksheet  Identifier"
    Exit  Function
    End  If
    worksheet.Delete
    RemoveWorksheet  =  "OK"
    End  Function
   
    'The  CreateNewWorkbook  method  creates  a  new  workbook  in  the  excel  application
    'ExcelApp  -  the  Excel  application  to  which  an  new  Excel  workbook  will  be  added
    Function  CreateNewWorkbook(ExcelApp)
    Set  NewWorkbook  =  ExcelApp.Workbooks.Add()
    Set  CreateNewWorkbook  =  NewWorkbook
    End  Function
   
    'The  OpenWorkbook  method  opens  a  previously  saved  Excel  workbook  and  adds  it  to  the  Application
    'excelApp  -  the  Excel  Application  the  workbook  will  be  added  to
    'path  -  the  path  of  the  workbook  that  will  be  opened
    'return  Nothing  on  failure
    Function  OpenWorkbook(ExcelApp,  path)
    On  Error  Resume  Next
    Set  NewWorkbook  =  ExcelApp.Workbooks.Open(path)
    Set  &#333;penWorkbook  =  NewWorkbook
    On  Error  GoTo  0
    End  Function
   
    'The  ActivateWorkbook  method  sets  on e  of  the  workbooks  in  the  application  as  Active  workbook
    'ExcelApp  -  the  workbook's  parent  excel  Application
    'workbookIdentifier  -  the  name  or  the  number  of  the  workbook
    Sub  ActivateWorkbook(ExcelApp,  workbookIdentifier)
    On  Error  Resume  Next
    ExcelApp.Workbooks(workbookIdentifier).Activate
    On  Error  GoTo  0
    End  Sub
   
    'The  CloseWorkbook  method  closes  an  open  workbook
    'ExcelApp  -  the  parent  Excel  application  of  the  workbook
    'workbookIdentifier  -  the  name  or  the  number  of  the  workbook
    Sub  CloseWorkbook(ExcelApp,  workbookIdentifier)
    On  Error  Resume  Next
    ExcelApp.Workbooks(workbookIdentifier).Close
    On  Error  GoTo  0
    End  Sub
   
    'The  CompareSheets  method  compares  between  two  sheets.
    'if  there  is  a  difference  between  the  two  sheets  then  the  value  in  the  second  sheet
    'will  be  changed  to  red  and  contain  the  string:
    '"Compare  conflict  -  Value  was  'Value2',  Expected  value  is  'value2'"
    'sheet1,  sheet2  -  the  excel  sheets  to  be  compared
    'startColumn  -  the  column  to  start  comparing  in  the  two  sheets
    'numberOfColumns  -  the  number  of  columns  to  be  compared
    'startRow  -  the  row  to  start  comparing  in  the  two  sheets
    'numberOfRows  -  the  number  of  rows  to  be  compared
    Function  CompareSheets(sheet1,  sheet2,  startColumn,  numberOfColumns,  startRow,  numberOfRows,  trimed)  'As  Boolean
    Dim  returnVal  'As  Boolean
    returnVal  =  True
   
    'In  case  that  on e  of  the  sheets  doesn't  exists,  don't  continue  the  process
    If  sheet1  Is  Nothing  Or  sheet2  Is  Nothing  Then
    CompareSheets  =  False
    Exit  Function
    End  If
   
    'loop  through  the  table  and  fill  values  into  the  two  worksheets
    For  r  =  startRow  to  (startRow  +  (numberOfRows  -  1))
    For  c  =  startColumn  to  (startColumn  +  (numberOfColumns  -  1))
    Value1  =  sheet1.Cells(r,  c)
    Value2  =  sheet2.Cells(r,  c)
   
    'if  'trimed'  equels  True  then  used  would  like  to  ignore  blank  spaces
    If  trimed  Then
    Value1  =  Trim(Value1)
    Value2  =  Trim(Value2)
    End  If
   
    'in  case  that  the  values  of  a  cell  are  not  equel  in  the  two  worksheets
    'create  an  indicator  that  the  values  are  not  equel  and  set  return  value
    'to  False
    If  Value1  <>  Value2  Then
    Dim  cell  'As  Excel.Range
    sheet2.Cells(r,  c)  =  "Compare  conflict  -  Value  was  '"  &  Value2  &  "',  Expected  value  is  '"  &  Value1  &  "'."
    Set  cell  =  sheet2.Cells(r,  c)
    cell.Font.Color  =  vbRed
    returnVal  =  False
    End  If
    Next
    Next
    CompareSheets  =  returnVal
    End  Function
 

版权声明：本文为博主原创文章，未经博主允许不得转载。