I have a procedure which I have pasted below. I am using the VBe Enterprise environment and all test machines are Windows XP Pro SP2 with the latest hotfixes. On my machine (the one with the dev env) I have no issues running the application I have written. The machine is a Sony Vaio.
I have tested it on a Dell Dimension 3100 and it runs there also.
When I try it on another Sony Vaio and also on a couple of other laptops, all of the same XP PRo SP2, I get Error #5.
The line in question is:
470 BigString$ = Left(BigString$, Len(BigString$) - 1) It is always this line. If I move it the error moves.
The routine essentially scans through a INF file and retrieves drivers that are used on the PC.
I have read elsewhere in newsgroups that adding DoEvents solves this. But not for me. I have also tried altering the line to use MID, but that also does not work.
Can someone please help, as I cannot move to .Net due to the fact that users will be foced to install .NET framework just for this app and a lot of them refuse as it is a live network.
Function ReadINF(fname As String, InfSec As String) ' !!!!!!!!!!!!! REMEMBER TO PASS INF SECTION VALUE Dim LineFromFile$, cfSTR$, cfPOS As Variant, cfTRIM$ Dim INF$() ' Load the INF File into this array Dim cfCOMPS$() 'define cf components array Dim CompFiles$() ' This is the array that will hold the actual file names Dim cnt, cnt2 Dim j As Variant, i As Variant, k As Variant, L As Variant, M As Variant Dim InfSecPos As String, ktemp As String Dim foundFlag As Boolean, FirstTimeFind As Boolean Dim BigString$ ' Used to make up a delimited String to populate an array to avoid ERR 9 Dim eqPOS ' Position of Equals sign in CopyFiles String Dim LBoundOfArray, UBoundOfArray, ArrayCounter 10 On Error GoTo ReadINF_Error 20 foundFlag = False 30 FirstTimeFind = False ' Attach the  40 InfSec = "[" + InfSec + "]" ' Set up the filesystem object 50 fname = Environ$("WINDIR") + "\inf\" + fname 60 Set fs = CreateObject("Scripting.FileSystemObject") 70 Set A = fs.OpenTextFile(fname, 1, 0) ' Read the inf file in and start process of query 80 cnt = 1 90 While Not A.AtEndOfStream 100 ReDim Preserve INF(cnt) As String 110 INF(cnt) = A.ReadLine 120 cnt = cnt + 1 130 DoEvents 140 Wend 150 A.Close ' First find the section 160 cfSTR$ = "" 170 For Each j In INF 180 If (InStr(1, j, InfSec, 1) = 1) And (foundFlag = False) Then foundFlag = True 190 If (foundFlag = True) And j = "" Then GoTo FoundEndOfSection 200 If (foundFlag = True) And (Mid(j, 1, 9) = "CopyFiles") Then 210 cfSTR = j 220 GoTo FoundEndOfSection 230 End If 240 Next FoundEndOfSection: ' Trim the "CopyFiles = " away 250 eqPOS = InStr(1, cfSTR, "=", vbTextCompare) 260 cfTRIM$ = Mid$(cfSTR, eqPOS + 1) 'Parse cfSTR into the individual components 270 cfCOMPS$() = Split(cfTRIM$, ",", -1) ' ****************************************************** ' Now find each section at a time and copy the files 280 foundFlag = False 290 cnt2 = 1 300 For Each k In cfCOMPS 310 BigString$ = "" 320 ktemp = k 330 ktemp = Mid(ktemp, 2) 340 InfSec = "[" + ktemp + "]" 350 LBoundOfArray = LBound(INF) 360 UBoundOfArray = UBound(INF) 370 ArrayCounter = 0 380 For Each L In INF ' Form1.Print (L) 390 If (InStr(1, L, InfSec, 1) = 1) And (foundFlag = False) Then foundFlag = True 400 If (foundFlag = True) And L = "" Then Exit For 410 If (foundFlag = True) And L <> "" Then 420 If L <> InfSec Then 430 BigString$ = BigString$ + L + "," 440 End If 450 End If 460 Next ' Finished scanning that aection - now remove trailing comma 470 BigString$ = Left(BigString$, Len(BigString$) - 1) 480 If foundFlag = True Then 490 DoEvents ' BigString$ = Mid(BigString$, 1, Len(BigString) - 1) 500 foundFlag = False ' Now pass BigString$ to the FileCopier. ' Form1.Print (BigString$) 510 CopyDrivers regroot$, BigString$ 520 End If 530 Next 540 On Error GoTo 0 550 Exit Function ReadINF_Error: 560 MsgBox "Error " & Err.Number & " at line:" & Erl & vbCrLf & " (" & Err.Description & ") in procedure ReadINF of Form Form1" End Function