actmanre
asked on
vbscript - Out of Memory - 800A0007
When I run the code below I get this error message on the second record processed in the loop (Line 101). The text file that I'm searching is very large (129 mb). Also all the data in the file is on one line. Any ideas why I'm getting this error? Can I clear out the memory after each loop? If so, what is the code to do that.
Below is the code from my .vbs file....
'************************* ********** ********** ********** ***
dim objConn
dim objRs
const ForReading = 1
const TristateFalse = 0
dim strSearchThis
dim objFS
dim objFile
dim objTS
dim objOutput
dim strFileName
dim sDB_USER
dim sDB_PASSWORD
dim intCount
dim strCurrentDateTime
sDB_USER = "UserName"
sDB_PASSWORD = "Password"
strCurrentDateTime = right("0000" & cstr(Year(Date())),4) & _
right("00" & cstr(Month(Date())),2) & _
right("00" & cstr(Day(Date())),2)
'Open dialog to select file to process.
dim ObjFileSeleted
dim InitFileSeleted
dim strFileSelected
Set ObjFileSeleted = CreateObject("UserAccounts .CommonDia log")
ObjFileSeleted.Filter = "Text Documents|*.txt"
ObjFileSeleted.FilterIndex = 3
ObjFileSeleted.InitialDir = "C:\"
InitFileSeleted = ObjFileSeleted.ShowOpen
If InitFileSeleted = False Then
Wscript.Echo "Script Error: Process canceled!"
Wscript.Quit
Else
strFileSelected = ObjFileSeleted.FileName
End If
'Select folder to save output file.
dim objShell
dim objBrowseFolder
dim objBrowseFolderItem
dim strFolderSelected
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Set objShell = CreateObject("Shell.Applic ation")
Set objBrowseFolder = objShell.Namespace(MY_COMP UTER)
Set objBrowseFolderItem = objBrowseFolder.Self
strPath = objBrowseFolderItem.Path
Set objShell = CreateObject("Shell.Applic ation")
Set objBrowseFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select a folder to save output file:", OPTIONS, strPath)
If objBrowseFolderItem Is Nothing Then
Wscript.Quit
End If
Set objBrowseFolderItem = objBrowseFolder.Self
strFolderSelected = objBrowseFolderItem.Path
'Open files.
set objFS = CreateObject("Scripting.Fi leSystemOb ject")
set objFile = objFS.GetFile(strFileSelec ted)
set objOutput = objFS.OpenTextFile(strFold erSelected & "Output_" & strCurrentDateTime & ".txt", 2, true)
'Write header record.
objOutput.write ("START: " & NOW() & vbcrlf & vbcrlf)
intCount = 0
'Connect to database and cycle through records.
set objConn = createobject("ADODB.Connec tion")
objConn.ConnectionString = "Driver={SQL Server};" & _
"Server=ServerName;" & _
"Database=DatabaseName;" & _
"Uid=" & sDB_USER & ";" & _
"Pwd=" & sDB_PASSWORD
objConn.Open
set objRs = createobject("ADODB.Record set")
objRs.ActiveConnection = objConn
strSQL = "SELECT LEFT([Field1],9) as FIELD " & _
"FROM [Table1] " & _
"WHERE [Field1] IS NOT NULL " & _
"AND RIGHT([Field1],1)='S' " & _
"ORDER BY [FIELD]"
objRs.Open strSQL,,3,3,1
WHILE NOT objRs.EOF
set objTS = objFile.OpenAsTextStream(F orReading, TristateFalse)
'Search for current value in recordset. Print record if found.
strSearchThis = objTS.Read(objFile.Size)
IF instr(strSearchThis, "REF*SY*" & objRs("FIELD") & "~") > 0 THEN
'Found it. Write out record.
objOutput.write (objRs("FIELD") & vbcrlf)
END IF
objTS.Close
intCount = intCount + 1
objRs.MoveNext
WEND
'Write trailer records.
objOutput.write (vbcrlf & "TOTAL RECORDS PROCESSED: " & intCount & vbcrlf)
objOutput.write ("FINISH: " & NOW())
'Close all open objects
objRs.Close
set objRs = Nothing
objConn.Close
set objConn = Nothing
objOutput.Close
set objFSO = Nothing
msgbox ("Finished")
'************************* ********** ********** ********** ***
Any help will be greatly appreciated.
Below is the code from my .vbs file....
'*************************
dim objConn
dim objRs
const ForReading = 1
const TristateFalse = 0
dim strSearchThis
dim objFS
dim objFile
dim objTS
dim objOutput
dim strFileName
dim sDB_USER
dim sDB_PASSWORD
dim intCount
dim strCurrentDateTime
sDB_USER = "UserName"
sDB_PASSWORD = "Password"
strCurrentDateTime = right("0000" & cstr(Year(Date())),4) & _
right("00" & cstr(Month(Date())),2) & _
right("00" & cstr(Day(Date())),2)
'Open dialog to select file to process.
dim ObjFileSeleted
dim InitFileSeleted
dim strFileSelected
Set ObjFileSeleted = CreateObject("UserAccounts
ObjFileSeleted.Filter = "Text Documents|*.txt"
ObjFileSeleted.FilterIndex
ObjFileSeleted.InitialDir = "C:\"
InitFileSeleted = ObjFileSeleted.ShowOpen
If InitFileSeleted = False Then
Wscript.Echo "Script Error: Process canceled!"
Wscript.Quit
Else
strFileSelected = ObjFileSeleted.FileName
End If
'Select folder to save output file.
dim objShell
dim objBrowseFolder
dim objBrowseFolderItem
dim strFolderSelected
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Set objShell = CreateObject("Shell.Applic
Set objBrowseFolder = objShell.Namespace(MY_COMP
Set objBrowseFolderItem = objBrowseFolder.Self
strPath = objBrowseFolderItem.Path
Set objShell = CreateObject("Shell.Applic
Set objBrowseFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select a folder to save output file:", OPTIONS, strPath)
If objBrowseFolderItem Is Nothing Then
Wscript.Quit
End If
Set objBrowseFolderItem = objBrowseFolder.Self
strFolderSelected = objBrowseFolderItem.Path
'Open files.
set objFS = CreateObject("Scripting.Fi
set objFile = objFS.GetFile(strFileSelec
set objOutput = objFS.OpenTextFile(strFold
'Write header record.
objOutput.write ("START: " & NOW() & vbcrlf & vbcrlf)
intCount = 0
'Connect to database and cycle through records.
set objConn = createobject("ADODB.Connec
objConn.ConnectionString = "Driver={SQL Server};" & _
"Server=ServerName;" & _
"Database=DatabaseName;" & _
"Uid=" & sDB_USER & ";" & _
"Pwd=" & sDB_PASSWORD
objConn.Open
set objRs = createobject("ADODB.Record
objRs.ActiveConnection = objConn
strSQL = "SELECT LEFT([Field1],9) as FIELD " & _
"FROM [Table1] " & _
"WHERE [Field1] IS NOT NULL " & _
"AND RIGHT([Field1],1)='S' " & _
"ORDER BY [FIELD]"
objRs.Open strSQL,,3,3,1
WHILE NOT objRs.EOF
set objTS = objFile.OpenAsTextStream(F
'Search for current value in recordset. Print record if found.
strSearchThis = objTS.Read(objFile.Size)
IF instr(strSearchThis, "REF*SY*" & objRs("FIELD") & "~") > 0 THEN
'Found it. Write out record.
objOutput.write (objRs("FIELD") & vbcrlf)
END IF
objTS.Close
intCount = intCount + 1
objRs.MoveNext
WEND
'Write trailer records.
objOutput.write (vbcrlf & "TOTAL RECORDS PROCESSED: " & intCount & vbcrlf)
objOutput.write ("FINISH: " & NOW())
'Close all open objects
objRs.Close
set objRs = Nothing
objConn.Close
set objConn = Nothing
objOutput.Close
set objFSO = Nothing
msgbox ("Finished")
'*************************
Any help will be greatly appreciated.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I moved the code...
************************** ********** ********** *****
set objTS = objFile.OpenAsTextStream(F orReading, TristateFalse)
'Search for current value in recordset. Print record if found.
strSearchThis = objTS.Read(objFile.Size)
************************** ********** ********** *****
...to above the while statement and the other code....
************************** ********** ********** *****
objTS.Close
************************** ********** ********** *****
...to below the wend statement and I did not get the out of memory error message.
**************************
set objTS = objFile.OpenAsTextStream(F
'Search for current value in recordset. Print record if found.
strSearchThis = objTS.Read(objFile.Size)
**************************
...to above the while statement and the other code....
**************************
objTS.Close
**************************
...to below the wend statement and I did not get the out of memory error message.
ASKER