为什么我执行一次脚本要半个小时以上，怎么解决啊？

xzcg · 发表于 2010-1-11 14:03:22

Report("C:\result1.xls")

Const ForReading = 1
Const ForWriting=2
Dim ResultArray(7)
Dim Attribute
Dim i
i=11
j=401
ISODrive="I:\"
destination="c:\test.txt"

Compuare_FirstTime()

Public Function Compuare_FirstTime()
  Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objTextFile= objFSO.OpenTextFile (destination, ForReading)
   Do Until objTextFile.AtEndOfStream
   FileLine = objTextFile.ReadLine
   ISO_Path=ISODrive+trim(FileLine)
   If  objFSO.FileExists(ISO_Path)Then
   f=objFSO.GetFile(ISO_Path)
      ResultArray(0)=FileLine
      ResultArray(1)=ISO_Path
      ResultArray(2)="Exists"
      Attribute=ShowFileAccessInfo(ISO_Path)
      ResultArray(3)=Attribute(0)
      ResultArray(4)=Attribute(1)
      ResultArray(5)=Attribute(2)
      ResultArray(6)=Attribute(3)
ReportToExcel ResultArray,i
      i=i+1
   else
      ResultArray(0)=FileLine
      ResultArray(1)="NULL"
      ResultArray(2)="Do not Exists"
   ReportToExcel ResultArray,j
   j=j+1
  End if

Loop
objTextFile.Close
Set objFSO=Nothing
End Function

Function ShowFileAccessInfo(filespec)
Dim attribute(4)
Dim fso, f, s
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(filespec)
attribute(0)=ShowFileVersion(filespec)
attribute(1)=f.DateCreated
attribute(2)=f.DateLastModified
attribute(3)=f.size
ShowFileAccessInfo=attribute
End Function

Function ShowFileVersion(filespec)
Dim wShell, exec,version_original,version,command
Set wShell = CreateObject( "WScript.Shell" )
command="%comspec% /C filever.exe" +" " +filespec
Set exec = wShell.Exec( command )
version_original=exec.StdOut.ReadALL
ShowFileVersion=mid(version_original,27,10)
End Function

public Sub ReportToExcel(ByVal ResultArray,n)
Set fso=CreateObject("Scripting.FileSystemObject")
Set oExcel=CreateObject("Excel.Application")
Set objWorkBook = oExcel.Workbooks.Open("c:\result1.xls")
Set objSheet = oExcel.Sheets("Testing Result")
With objSheet
   Environment.Value("Row") = .Range("C7").Value + n
   .Cells(Environment("Row"),2).value = ResultArray(0)
   .Cells(Environment("Row"),3).value = ResultArray(1)
   .Cells(Environment("Row"),4).value = ResultArray(2)
   .Cells(Environment("Row"),5).value = ResultArray(3)
   .Cells(Environment("Row"),6).value = ResultArray(4)
   .Cells(Environment("Row"),7).value = ResultArray(5)
   .Cells(Environment("Row"),8).value = ResultArray(6)
End With
objWorkBook.Save
oExcel.Quit
Set objSheet = Nothing
Set objWorkBook = Nothing
Set oExcel = Nothing
Set fso = Nothing
End Sub

Public Function Report(ReportExcelFile)
Dim fso
Dim oExcel
Dim ExcelFile
Dim TestCaseName
Dim objWorkBook
Dim objSheet
Dim NewTC
Dim Status
Dim temp
Dim PngPath

Set fso=CreateObject("Scripting.FileSystemObject")
Set oExcel=CreateObject("Excel.Application")

Status=UCase(sStatus)
'oExcel.Visable=false

If Not fso.FileExists(ReportExcelFile) Then
   oExcel.Workbooks.Add

   Set objSheet=oExcel.Sheets.Item(1)
   oExcel.Sheets.Item(1).Select
   With objSheet
   .Name="Testing Result"
   .Columns("A:A").ColumnWidth=5
   .Columns("B:B").ColumnWidth=100
      .Columns("C:C").ColumnWidth=100
   .Columns("D

").ColumnWidth=60
   .Columns("E:E").ColumnWidth=80
   .Columns("F:F").ColumnWidth=80
   .Columns("F:F").ColumnWidth=80
   .Columns("G:G").ColumnWidth=80
   .Columns("H:H").ColumnWidth=80
   .Columns("A:H").HorizontalAlignment=-4131
   .Columns("A:H").WrapText=True

   .Range("A:H").Font.Name="Arial"
   .Range("A:H").Font.Size=10

   .Range("B1").Value="Testing Result"
   .Range("B1:C1").Merge

   .Range("B1:C1").Interior.ColorIndex=53
   .Range("B1:C1").Font.ColorIndex=19
   .Range("B1:C1").Font.Bold=True

   .Range("B3").Value="Test Date:"
   .Range("B4").Value="Test Start Time:"
   .Range("B5").Value="Test End Time:"
   .Range("B6").Value="Test Duration:"
   .Range("C3").Value=Date
   .Range("C4").Value=Time
   .Range("C5").Value=Time
   .Range("C6").Value="=R[-1]C-R[-2]C"
   .Range("C6").NumberFormat="[h]:mm:ss;@"

   .Range("B3:C8").Interior.ColorIndex = 40
   .Range("B3:C8").Font.ColorIndex = 12
   .Range("C3:C8").Font.ColorIndex = 7
   .Range("B3:A8").Font.Bold = True
   .Range("B7").Value = "No Of Testcases:"
   .Range("C7").Value= "0"
   .Range("B8").Value= "Testing Machine:"
   ' .Range("C8").Value =GetIP()
   .Range("B10").Value = "File list item"
   .Range("C10").Value = "ISO list item"
   .Range("D10").Value = "Compare Result"
   .Range("E10").Value = "ISO item Version"
   .Range("F10").Value = "ISO item Created"
   .Range("G10").Value = "ISO item Modified"
   .Range("H10").Value = "ISO item size"

      ' set style for Result Summery
   .Range("B10:H10").Interior.ColorIndex = 53
   .Range("B10:H10").Font.ColorIndex = 19
   .Range("B10:H10").Font.Bold = True

   'set style for Result Summery
   .Range("B10:H10").Borders(1).LineStyle= 1
   .Range("B10:H10").Borders(2).LineStyle= 1
   .Range("B10:H10").Borders(3).LineStyle= 1
   .Range("B10:H10").Borders(4).LineStyle= 1
   .Range("B10:H10").HorizontalAlignment= -4131
   .Range("C11:C1000").HorizontalAlignment= -4131
   .Columns("B:H").Select '
   .Columns("B:H").Autofit
   .Range("B11").Select

   .Range("B400").Value = "File list item"
   .Range("C400").Value = "ISO list item"
   .Range("D400").Value = "Compare Result"
   .Range("E400").Value = "ISO item Version"
   .Range("F400").Value = "ISO item Created"
   .Range("G400").Value = "ISO item Modified"
   .Range("H400").Value = "ISO item size"


   ' set style for Result Summery
   .Range("B400:H400").Interior.ColorIndex = 53
   .Range("B400:H400").Font.ColorIndex = 19
   .Range("B400:H400").Font.Bold = True

   'set style for Result Summery
   .Range("B400:H400").Borders(1).LineStyle= 1
   .Range("B400:H400").Borders(2).LineStyle= 1
   .Range("B400:H400").Borders(3).LineStyle= 1
   .Range("B400:H400").Borders(4).LineStyle= 1
   .Range("B400:H400").HorizontalAlignment= -4131
   .Range("C400:C1000").HorizontalAlignment= -4131
   .Columns("B:H").Select '
   .Columns("B:H").Autofit
   .Range("B11").Select
   End with
   oExcel.ActiveWindow.FreezePanes = True
   oExcel.ActiveWorkbook.SaveAs ReportExcelFile
   oExcel.Quit
   Set objSheet = Nothing
End If
End Function

Public Function GetIP
ComputerName="."
Dim objWMIService,colItems,objItem,objAddress
Set objWMIService = GetObject("winmgmts:\\" & ComputerName & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * FromWin32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objItem in colItems
      For Each objAddress in objItem.IPAddress
If objAddress <> "" then
GetIP = objAddress
Exit Function
End If
Next
  Next
End Function

[ 本帖最后由 xzcg 于 2010-1-11 14:04 编辑 ]