为什么我执行一次脚本要半个小时以上，怎么解决啊？
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)
IfobjFSO.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: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=":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 编辑 ]
哪个地方有问题啊？
我拿别的脚本语言写只用2分钟就执行完了 把脚本分段运行，先定位出是哪部分脚本耗费的时间最长解决了 是一个变量的区域设置错了
解决了 是一个变量的区域设置错了多谢
页:
[1]
