Error running VBScript (.VBS) File

ASP Free Forums Sponsor:

December 12th, 2006, 09:49 AM

mehere

Senior Sarcasm Wizardess

Join Date: Feb 2005

Location: Dreamland

Posts: 12,867

Folding Points: 10976 Folding Title: Novice Folder

Time spent in forums: 4 Months 4 Weeks 15 h 20 m 54 sec
Reputation Power: 1762

Error running VBScript (.VBS) File

I have a .VBS file that when run on my local machine, has no problems. Now that it has been moved to the production server, I get an error. The script takes all same files (first 6 characters of a file name) within a directory/sub directory structure and creates a batch file to combine these text files into one file.

vb Code:

Original - vb Code

Option Explicit
	
Dim strPath, strArchive, strDisallow, strCombine
Dim oFSO, oFolder, oFiles, oPath, sFolder
Dim x, s
Dim rs
Dim oNew, strFile, strBatch, strBat
Dim newFolder, nFolder
Dim wShell

Const adVarChar = 200
strDisallow = "|archive|combine|"

Dim argObj, varFile, varExtension, varLength
Set argObj = WScript.Arguments

'First parameter
varFile = lcase(trim(argObj(0)))
varLength = Len(trim(argObj(0)))
'Second parameter
varExtension = lcase(trim(argObj(1)))
'MsgBox varFile & " - " & varExtension

main()
	
Function main()

Const directory = "C:\Inetpub\wwwroot\test"
	Const archive = "C:\Inetpub\wwwroot\test\archive\"
	Const combined = "C:\Inetpub\wwwroot\test\combine\"

strPath = directory
	strArchive = archive
	strCombine = combined
	
	' Create our FSO
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	' Get a handle on our folder
	Set oFolder = oFSO.GetFolder(strPath)
	
	set rs = CreateObject("ADODB.Recordset")
	rs.Fields.Append "name", adVarChar, 8000
	rs.Fields.Append "location", adVarChar, 8000
	rs.Open
	
	oPath = oFolder.Path
	Set oFiles = oFolder.Files
	For Each x In oFiles
		If LCase(Left(x.Name,varLength)) = varFile Then
			If lcase(Right(x.Name,3)) = varExtension Then
				rs.AddNew
				rs.Fields("location").Value = oPath & "\" & x.Name & " + "
				rs.Fields("name").Value = x.Name
			End If
		End If
	Next
	
	getSubFolders oFSO.GetFolder(strPath)

'Remove File & Folder objects		
	Set oFiles = Nothing
	Set oFolder = Nothing
	
	' Now we can sort our data:
	' Sort ascending by name
	With rs
		.Sort = "name ASC"
		Do While Not .EOF
			strBatch = strBatch & .Fields("location").Value
			strFile = strFile & .Fields("name").Value & ", "
			.MoveNext
		Loop
	end With
	
	strBatch = left(strBatch,Len(strBatch)-3)
	strBat = varFile & ".bat"
	
	'Create batchfile needed to combine files
	Set oNew = oFSO.CreateTextFile(strPath & "\" & strBat)
	oNew.WriteLine("echo off")
	oNew.WriteLine("REM combines the individual files into one large file")
	oNew.WriteLine("copy /b " & strBatch &  " " & strCombine & varFile & ".DAT")
	oNew.WriteLine("REM pause")
	oNew.WriteLine("echo on")
	oNew.Close
	'Remove new batch file object
	Set oNew=Nothing
	
	strBatch = ""
	newFolder = strArchive & varFile
	If Not oFSO.FolderExists(newFolder) Then
   		Set nFolder = oFSO.CreateFolder(newFolder)
   	End If
   	'Remove the new folder object
   	Set nFolder = Nothing
	
	'Run batchfile to combine the files
	Dim runBat
	runBat = strPath & "\" & strBat
	'MsgBox runBat
	set wShell = CreateObject("WScript.Shell") 
	wshell.run runBat, 0, True
	set wShell = Nothing
	
	'Move files to archive directory
	With rs
		.MoveFirst
		Do While Not .EOF
			strBatch = Left(.Fields("location").Value,Len(.Fields("location").Value)-3)
			If oFSO.FileExists(strBatch) Then
				oFSO.MoveFile strBatch, newFolder & "\"
				'MsgBox strBatch & " " & newFolder 
	   		End If
   			.MoveNext
   		Loop
   	End With	
	
	'Close/remove ADO Recordset object
	rs.Close
	Set rs = Nothing
	'Remove FileSystemObject
	Set oFSO = Nothing	
End Function

Sub getSubFolders(Folder)
	For Each sFolder In Folder.SubFolders
		If InStr(LCase(strDisallow),"|" & LCase(sFolder.Name) & "|") = 0 Then
	        oPath = sFolder.Path
	        Set oFolder = oFSO.GetFolder(oPath)
	        Set oFiles = oFolder.Files
	       	For Each x In oFiles
				If LCase(Left(x.Name,varLength)) = varFile Then
					If LCase(Right(x.Name,3)) = varExtension Then
						rs.AddNew
						rs.Fields("location").Value = oPath & "\" & x.Name & " + "
						rs.Fields("name").Value = x.Name
					End If
				End If
			Next
		End If
        getSubFolders oFolder
    Next
End Sub

 
Option Explicit
    
Dim strPath, strArchive, strDisallow, strCombine
Dim oFSO, oFolder, oFiles, oPath, sFolder
Dim x, s
Dim rs
Dim oNew, strFile, strBatch, strBat
Dim newFolder, nFolder
Dim wShell
 
Const adVarChar = 200
strDisallow = "|archive|combine|"
 
Dim argObj, varFile, varExtension, varLength
Set argObj = WScript.Arguments
 
'First parameter
varFile = lcase(trim(argObj(0)))
varLength = Len(trim(argObj(0)))
'Second parameter
varExtension = lcase(trim(argObj(1)))
'MsgBox varFile & " - " & varExtension 
 
main()
    
Function main()
 
    Const directory = "C:\Inetpub\wwwroot\test"
    Const archive = "C:\Inetpub\wwwroot\test\archive\"
    Const combined = "C:\Inetpub\wwwroot\test\combine\"
 
    strPath = directory
    strArchive = archive
    strCombine = combined
    
    ' Create our FSO
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    ' Get a handle on our folder
    Set oFolder = oFSO.GetFolder(strPath)
    
    set rs = CreateObject("ADODB.Recordset")
    rs.Fields.Append "name", adVarChar, 8000
    rs.Fields.Append "location", adVarChar, 8000
    rs.Open
    
    oPath = oFolder.Path
    Set oFiles = oFolder.Files
    For Each x In oFiles
        If LCase(Left(x.Name,varLength)) = varFile Then
            If lcase(Right(x.Name,3)) = varExtension Then
                rs.AddNew
                rs.Fields("location").Value = oPath & "\" & x.Name & " + "
                rs.Fields("name").Value = x.Name
            End If
        End If
    Next
    
    getSubFolders oFSO.GetFolder(strPath)
 
    'Remove File & Folder objects      
    Set oFiles = Nothing
    Set oFolder = Nothing
    
    ' Now we can sort our data:
    ' Sort ascending by name
    With rs
        .Sort = "name ASC"
        Do While Not .EOF
            strBatch = strBatch & .Fields("location").Value
            strFile = strFile & .Fields("name").Value & ", "
            .MoveNext
        Loop
    end With
    
    strBatch = left(strBatch,Len(strBatch)-3)
    strBat = varFile & ".bat"
    
    'Create batchfile needed to combine files
    Set oNew = oFSO.CreateTextFile(strPath & "\" & strBat)
    oNew.WriteLine("echo off")
    oNew.WriteLine("REM combines the individual files into one large file")
    oNew.WriteLine("copy /b " & strBatch &  " " & strCombine & varFile & ".DAT")
    oNew.WriteLine("REM pause")
    oNew.WriteLine("echo on")
    oNew.Close
    'Remove new batch file object
    Set oNew=Nothing
    
    strBatch = ""
    newFolder = strArchive & varFile
    If Not oFSO.FolderExists(newFolder) Then
     Set nFolder = oFSO.CreateFolder(newFolder)
    End If
    'Remove the new folder object
    Set nFolder = Nothing
    
    'Run batchfile to combine the files
    Dim runBat
    runBat = strPath & "\" & strBat
    'MsgBox runBat
    set wShell = CreateObject("WScript.Shell") 
    wshell.run runBat, 0, True
    set wShell = Nothing
    
    'Move files to archive directory
    With rs
        .MoveFirst
        Do While Not .EOF
            strBatch = Left(.Fields("location").Value,Len(.Fields("location").Value)-3)
            If oFSO.FileExists(strBatch) Then
                oFSO.MoveFile strBatch, newFolder & "\"
                'MsgBox strBatch & " " & newFolder 
         End If
      .MoveNext
     Loop
    End With 
    
    'Close/remove ADO Recordset object
    rs.Close
    Set rs = Nothing
    'Remove FileSystemObject
    Set oFSO = Nothing  
End Function    
 
Sub getSubFolders(Folder)
    For Each sFolder In Folder.SubFolders
        If InStr(LCase(strDisallow),"|" & LCase(sFolder.Name) & "|") = 0 Then
            oPath = sFolder.Path
            Set oFolder = oFSO.GetFolder(oPath)
            Set oFiles = oFolder.Files
            For Each x In oFiles
                If LCase(Left(x.Name,varLength)) = varFile Then
                    If LCase(Right(x.Name,3)) = varExtension Then
                        rs.AddNew
                        rs.Fields("location").Value = oPath & "\" & x.Name & " + "
                        rs.Fields("name").Value = x.Name
                    End If
                End If
            Next
        End If
        getSubFolders oFolder
    Next
End Sub

it bombs out on line 127: For Each sFolder In Folder.SubFolders with the following error.
Microsoft VBScript runtime error: Out of Memory: 'Folder.SubFolders'.

Any clue as to what this can mean. Again, it runs fine on my machine, where it was written, but will not run on the production server.

Thanks.

__________________
Come JOIN the party!!!

Quote of the Month:
Retirement: Because you've given so much of yourself to the company that you don't have anything left we can use.

Questions to Ponder:
What do you do when you see an endangered animal eating an endangered plant?

iif([sarcasm]=true,iif([you have to ask]=true,"didn't work","ha ha ha"),"not sarcasm")
copyright© 2008 sbenj69

December 12th, 2006, 10:02 AM

chapman10s

**Wanted Wizard**

Join Date: Apr 2006

Location: Who knows...

Posts: 5,410

Folding Points: 12139 Folding Title: Novice Folder

Time spent in forums: 3 Weeks 4 Days 12 h 36 m
Reputation Power: 1331

Mehere--

Usually that is referring to an infinite loop somewhere? Since the code in the vbs script searches the list of parent sources until the end, there is a stack overflow (out of memory) which eventually occurs because there is no end. Just a hunch i guess....

__________________
I would rather know than not know at all...

December 12th, 2006, 10:05 AM

mehere

Senior Sarcasm Wizardess

Join Date: Feb 2005

Location: Dreamland

Posts: 12,867

Time spent in forums: 4 Months 4 Weeks 15 h 20 m 54 sec
Reputation Power: 1762

i kinda went that way, but the directory it runs in has 7 subdirectories and no directories under those subs. when i ran it on my machine, i had 15 directories, with at least 2-3 subdirectories under each one of those and it runs with no problems. i'm stumped, to say the least.

December 12th, 2006, 06:14 PM

Shadow Wizard

Moderator From Beyond

ASP Free God 46th Plane (27500 - 27999 posts)

Join Date: Sep 2004

Location: Israel

Posts: 27,635

Folding Points: 373781 Folding Title: Super Ultimate Folder - Level 1

Time spent in forums: 3 Months 2 Weeks 2 h 55 m 37 sec
Reputation Power: 1902

--moved to the brand new Windows Scripting forum.

well, first of all I noticed the Archive and Combined are
part of the main folder - it might be better idea to have
them outside, for example:

Code:

	Const directory = "C:\Inetpub\wwwroot\test"
	Const archive = "C:\Inetpub\wwwroot\archive\"
	Const combined = "C:\Inetpub\wwwroot\combine\"

if still no luck, Debug for the Rescue:

Code:

Sub getSubFolders(Folder)
    MsgBox("getSubFolders called for: " & Folder.Name)   
    For Each sFolder In Folder.SubFolders
        ...

it would at least verify whether it's infinite loop or not...

Comments on this post

mehere agrees: thanks

__________________

Visit The Windows Scripting Guru

December 13th, 2006, 07:29 PM

mehere

Senior Sarcasm Wizardess

Join Date: Feb 2005

Location: Dreamland

Posts: 12,867