Script is too slow , Howto speed up ?

[bolobaboo]

Hi
I am using following code to update excel sheet. Excel sheet is around 3MB in size.. It picks one name from list and looks entire sheet for match , once find match it updates 2 column.Only problem,code is tool slow to check each name against sheet.Some time it takes around 2 minute for each name. Is there any other way to do this ( howto speed up ) ?


Option Explicit

Dim fs,objTextFile,newdate,newlocation,sctape
Dim strText0, arrStr,objExcel,objSpread,intRow,X

Set fs=CreateObject("Scripting.FileSystemObject")
'ForReading=1, you must use values
Set objTextFile = fs.OpenTextFile("c:\anil\list.txt", 1)
' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open("c:\anil\filesystemlayoutfornbu.xls")


Do Until objTextFile.AtEndOfStream
intRow = 2 'Row 1 often contains headings
arrStr = Split(objTextFile.ReadLine,vbcrlf)
strText0 = arrStr(0)
Do Until objExcel.Cells(intRow, 1).Value = ""
sctape = objExcel.Cells(intRow, 1).Value
If InStr(sctape,strText0) Then
objExcel.Cells(intRow, 3) = newdate
objExcel.Cells(intRow, 5) = newlocation
End If
intRow = intRow + 1
Loop
Loop
'Clean Up
objTextFile.Close
set objTextFile = Nothing
objExcel.Application.Quit
set fs = Nothing
wscript.quit

 

[markdmac]

I don't see the logic in looping through the text file when you only want the first line. I further don't get why you have nested the Excel part in that loop.

Give this a try instead.

Dim fs,objTextFile,newdate,newlocation,sctapeDim strText0, arrStr,objExcel,objSpread,intRow,XSet 
fs=CreateObject("Scripting.FileSystemObject")
Const ForReading=1
'Open the text file
objTextFile = fs.OpenTextFile("c:\anil\list.txt", ForReading)
'Now just read the first line
strText0 = objTextFile.ReadLine
'Close the text file
objTextFile.Close

' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open("c:\anil\filesystemlayoutfornbu.xls")

intRow = 2 'Row 1 often contains headings    
Do Until objExcel.Cells(intRow, 1).Value = ""       
	sctape = objExcel.Cells(intRow, 1).Value       
	If InStr(sctape,strText0) Then           
		objExcel.Cells(intRow, 3) = newdate           
		objExcel.Cells(intRow, 5) = newlocation                             
	End If       
	intRow = intRow + 1    
Loop

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.