I have a process that loops through a moderate amount of data (1MB) storing it in an array and then periodically writes it to the disk. After several iterations, the script fails at fso.OpenTextFile() in my else section as though the file has not been closed or finished closing from the previous time the function was called. The iteration # doesn't seem to be specific as it's happened anywhere between the 2nd and 10th iteration that I can tell. The file is actually created and being appended to so it doesn't appear to be a permissions issue. I considering adding a time delay to the process but don't want to necessarily add overhead to an already long process.
OS: Windows 2012 R2
Any thoughts or suggestions appreciated.
'Write array to disk
sub writeFile()
'on error resumenext
set fso = Server.CreateObject("Scripting.FileSystemObject")
if needToCreateFile then
set objTextFile = fso.CreateTextFile(server.mappath("google/linklist.html"),true)
objTextFile.writeLine("<!DOCTYPE html>")
objTextFile.writeLine("<html>")
objTextFile.writeLine("<title>")
objTextFile.writeLine("Content Listing")
objTextFile.writeLine("</title>")
needToCreateFile = false
else
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Set objTextFile = fso.OpenTextFile (filename, ForAppending, True)
end if
'Write contents of array to file
for each link in linkList
if link <>"" and not isNull(link) then
objTextFile.writeLine(link & "<br>")
end if
next
objTextFile.writeLine("</html>")
objTextFile.Close
set fso = nothing
set objTextFile = nothing
'on error goto 0
end sub
Follow Up - Solved
Adding a 3 second delay solved the problem, but significantly delayed the processing time. So, rather than opening and closing the file each time I wanted to write to it, I simply left it open until the entire script was done and thus I didn't need the delay.
sub writeFile()
if needToCreateFile then
set objTextFile = fs.CreateTextFile(server.mappath("google/linklist.html"),true)
objTextFile.writeLine("<!DOCTYPE html>")
objTextFile.writeLine("<html>")
objTextFile.writeLine("<title>")
objTextFile.writeLine("Content Listing")
objTextFile.writeLine("</title>")
needToCreateFile = false
end if
'Write contents of array to file
for each link in linkList
if link <>"" and not isNull(link) then
objTextFile.writeLine(link & "<br>")
end if
next
objTextFile.writeLine("</html>")
' objTextFile.Close
' set fso = nothing
' set objTextFile = nothing
end sub
Adding a 3 second delay solved the problem, but significantly delayed the processing time. So, rather than opening and closing the file each time I wanted to write to it, I simply left it open until the entire script was done and thus I didn't need the delay. See modified script above.
Related
I have a VBScript which is used in Avaya CMS to generate a CSV every 3 seconds. This CSV is then read on each change by a node server.
Every now and then it will throw an error (Error 52) and it then requires someone to manually click OK on the prompt and then it continues.
I didn't write the initial script, but I have been trying to fix it so it doesn't throw this error.
As far as I understand, the issue is being caused when the script tries to write to the file when the node server is trying to read the file.
So far I have tried to fix this by making the file read only, then, in the script it makes it writeable, writes to it and makes it read only again.
I thought this had fixed the issue, but I have received Error 52 pop up again and now I am unsure.
Does anyone know if there is a way to get VB/Avaya to ignore the error? I was thinking something like putting On Error Resume Next before the line that writes the file?
I know ignoring errors is not good practice, but in this case, if it does ignore it, it just means the file wont be updated on this loop, but 3 seconds later it will loop again so it should be fine.
Script:
On Error Resume Next
cvsSrv.Reports.ACD = 1
Set Info = cvsSrv.Reports.Reports("Real-Time\Designer\Skill Status")
If Info Is Nothing Then
Else
b = cvsSrv.Reports.CreateReport(Info,Rep)
If b Then
Rep.RefreshInterval = 3
Rep.SetProperty "Split/Skill","5"
Set WshShell = CreateObject("WScript.Shell")
theHTMLLocation = "C:\wamp\www\wallboards\agent_status.csv"
theSleepFile = "C:\wamp\www\wallboards\sleep.vbs"
theTemplateLocation = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set gfile = fso.GetFile("C:\wamp\www\wallboards\agent_status.csv")
Do While Rep.Window.Caption <> ""
gfile.Attributes = 0
d = Rep.ExportData("C:\wamp\www\wallboards\agent_status.csv", 44, 0, False, True, True)
gfile.Attributes = 1
WshShell.Run "wscript.exe """ & theSleepFile & """", , True
Loop
If Not cvsSrv.Interactive Then cvsSrv.ActiveTasks.Remove Rep.TaskID
Set Rep = Nothing
End If
End If
Set Info = Nothing
P.S - I left out some Parameters at that start of the file which I don't think are relevant, if someone thinks they are I will add them.
I've got a simple program than scans data into a spreadsheet along with a timestamp, then you can either update the data by saving, or quit and exit and save.
The only issue I've been stuck on for a day or so is to work around the error handling of the case of the spreadsheet being already open. Id like to have something like this;
if file is open THEn msgbox("File is open, close file and start again")
WScript.Quit
Option Explicit
DIM oFs: Set oFs = CreateObject("Scripting.FileSystemObject")
DIM objExcel, strExcelPath, objSheet
DIM ib
DIM msg1
DIM msg2
strExcelPath = "c:\temp\Example.xls"
Set objExcel = CreateObject("Excel.Application")
objExcel.WorkBooks.Open strExcelPath
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
DO
ib=inputbox("SCAN NAME, SCAN LOTS"&vbCrLf&"TO UPDATE,SCAN ""UPDATE."""&vbCrLf&"TO EXIT, SCAN ""QUIT.""","Picklot Passout Database")
IF ib="" THEN
msg1=MsgBox("You must scan either a NAME or LOT NUMBER."&vbCrLf&"If you want to exit, scan QUIT."&vbCrLf&"Click OK to continue.",vbokonly,"Cannot Insert Blank Data")
ELSEIF ib= "QUIT" OR ib= "quit" THEN
objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
set objExcel = Nothing
Set oFs = Nothing
ELSEIF ib="update" OR ib="UPDATE" THEN
objExcel.ActiveWorkbook.Save
msg2=MsgBox("Update Complete.",vbokonly,"Database Updated")
ELSE
objSheet.Range("A2").EntireRow.Insert
objSheet.Cells(2, 1).Value = ib
objSheet.Cells(2, 2).Value=(now)
END IF
LOOP WHILE NOT ib="quit" AND NOT ib="QUIT"
This may help point you in the right direction. Sorry for the rushed, lowercase syntax and unconventional indentations (do not follow my bad practice - keep yours! :D), I wrote it in notepad you see - but it has been tested successfully.
Anyhow, with reference to your code, I have restructured it in a bad manner, familiar to me, adding the functionality you specify. Essentially the task manager application list is checked for a running instance of the "example" Excel file (depending on what version of excel you're using the syntax will differ).
If found it will make it the active window (thereby preventing a read only duplicate instance initiating). If no instance is found it will open "example.xlsx", in this case using a relative path to the script itself. A subroutine is then called to do the business with the cells...
I have written it in such a way to try keep your specs as well as maintain the "OK" and "Cancel" buttons explicitly functional. Please feel free to tinker with this, you may need to address the path and instr lines differently. I hope it helps! All the best.
path=createobject("scripting.filesystemobject").getparentfoldername(wscript.scriptfullname)
excelpath=path&"\example.xlsx"
set objword=createobject("word.application")
set coltasks=objword.tasks
i=0
for each objtask in coltasks
name=lcase(objtask.name)
if instr(name, "microsoft excel - example") then
i=1
end if
next
if i=1 then
wscript.echo "An active instance of ""example.xlsx"" has been found"
set objexcel=getobject(excelpath)
call UPDATER
else
set objexcel=createobject("excel.application")
objexcel.workbooks.open(excelpath)
set objsheet=objexcel.activeworkbook.worksheets(1)
objexcel.visible=true
call UPDATER
end if
sub UPDATER
do
data=inputbox("Please enter data" &vbcrlf&vbcrlf& "To save data & continue, type ""update""" &vbcrlf& "To save data & exit, type ""quit""","Excel DB Updater")
if isempty(data) then
objexcel.activeworkbook.close
objexcel.application.quit
wscript.quit()
elseif lcase(data)="quit" then
objexcel.activeworkbook.save
objexcel.activeworkbook.close
objexcel.application.quit
quit=msgbox("DB Updating complete",vbokonly,"Excel DB Updater")
wscript.quit
elseif lcase(data)="update" then
objexcel.activeworkbook.save
update=msgbox("Data save complete, press OK to continue",vbokonly,"Excel DB Updater")
elseif len(data)<>0 then
objsheet.range("A1").entirerow.insert
objsheet.cells(1, 1).value=data
objsheet.cells(1, 2).value=(now)
add=msgbox("Data added, press OK to continue",vbokonly,"Excel DB Updater")
end if
loop while len(data)>=0 and not lcase(data)="quit"
end sub
I found online script that basically unzip every .zip archive in a given path.
sub UnzipAll(path)
set folder = fso.GetFolder(path)
for each file in folder.files
if (fso.GetExtensionName(file.path)) = "zip" then
set objShell = CreateObject("Shell.Application")
objshell.NameSpace(path).CopyHere objshell.NameSpace(file.path).Items
file.delete
end if
next
end sub
This is actually working, but the problem is that I want to unzip "silently" (silently means that I don't want any kind of message from the system when unzipping, like "do you want to overwrite?" ect.).
I've searched a lot on google and I found that you just need to add a few flags on the "CopyHere" method, like this:
objshell.NameSpace(path).CopyHere objshell.NameSpace(file.path).Items, *FLAGHERE*
But the problem is right here. The flags would normally work, but they are completely ignored when unzipping a .zip archive.
So I searched for a workaround, but I didn't find anything helpful.
I managed to do it by myself. Basically you want to unzip 1 file per time and not everyone togheter, and before copying it you just check if it already exists, and evenutally delete it:
set fso = CreateObject("Scripting.FileSystemObject")
sub estrai(percorso)
set cartella = fso.GetFolder(percorso)
for each file in cartella.files
if fso.GetExtensionName(file.path) = "zip" then
set objShell = CreateObject("Shell.Application")
set destinazione = objShell.NameSpace(percorso)
set zip_content = objShell.NameSpace(file.path).Items
for i = 0 to zip_content.count-1
'msgbox fso.Buildpath(percorso,zip_content.item(i).name)+"."+fso.getExtensionName(zip_content.item(i).path)
if (fso.FileExists(fso.Buildpath(percorso,zip_content.item(i).name)+"."+fso.getExtensionName(zip_content.item(i).path))) then
'msgbox "il file esiste, ora lo cancello"
fso.DeleteFile(fso.Buildpath(percorso,zip_content.item(i).name)+"."+fso.getExtensionName(zip_content.item(i).path))
end if
destinazione.copyHere(zip_content.item(i))
next
file.Delete
end if
next
'for each sottocartella in cartella.subfolders
' call estrai(folder.path)
'next
end sub
call estrai("C:\Documents and Settings\Mattia\Desktop\prova")
I have next to zero knowledge on vbs scripting but I have managed to cobble a few together to copy files from one directory to another and delete files in a directory but I've not been able to find anything specifically what I'm now after.
I'm looking to write a vbs script to do the following - copy file/s beginning with XXX or YYY or ZZZ from directory A to directory B.
I've had a look around and cannot quite find what I'm looking for, they all seem far too complex for what I need and involve the latest date or parsing a string within the files etc.
I'm quite sure this is simple but as stated at the top I really do not know what I'm doing so any help would be greatly appreciated.
The following is what I have for copying all files from one directory to another with a progress bar so a amendment to this would be great.
Const FOF_CREATEPROGRESSDLG = &H0&
' copy test 1 to test 2
strTargetFolder = "C:\test2\"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(strTargetFolder)
objFolder.CopyHere "C:\test1\*.*", FOF_CREATEPROGRESSDLG
Not sure as of yet how to get this in one big progress indicator. Currently it will show progress for each individual file.
Const FOF_CREATEPROGRESSDLG = &H0&
strSourceFolder = "C:\test1\"
strTargetFolder = "C:\test2\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSourceFolder = objFSO.GetFolder(strSourceFolder)
Set objFiles = objSourceFolder.Files
Set objShell = CreateObject("Shell.Application")
Set objTargetFolder = objShell.NameSpace(strTargetFolder)
For Each objSingleFile in objFiles
If (InStr(1,objSingleFile.Name,"xxx",vbTextCompare) = 1) Or _
(InStr(1,objSingleFile.Name,"yyy",vbTextCompare) = 1) Or _
(InStr(1,objSingleFile.Name,"zzz",vbTextCompare) = 1) Then
' The file name starts with one the flagged keywords
objTargetFolder.CopyHere objSingleFile.Path, FOF_CREATEPROGRESSDLG
End If
Next
Keep your strTargetFolder code which is used for the actual copy procedure used at the end of the script. Using the FileSystemObject objFSO we cycle through all the files of the directory c:\test1. Each file name is then checked to see if it starts with either of 3 different strings. The comparison is done using vbTextCompare which essentially has it running case insensitive. If a match is found then, using your original code, copy the file to the target directory with progress.
Currently this is not going to recursively navigate all subfolders for file but you could make a recursive function for that.
Use the FileSystemObject in combination with a regular expression:
src = "C:\test1"
dst = "C:\test2"
Set fso = CreateObject("Scripting.FileSystemObject")
Set re = New RegExp
re.Pattern = "^(XXX|YYY|ZZZ)"
For Each f In fso.GetFolder(src).Files
If re.Test(f.Name) Then f.Copy dst & "\"
Next
I'm getting an error when i use opentextfile. The problem is weird because it works for a few hundred files then pops up.
Basically the script gets a collection of files, searchs in them for a string which it then removes and writes back the modified content to the same file. The problem occurs when the script wants to open the file again so it can write the modified contents to it.
This is the code:
For Each objFile in colFiles
Set objCurrentFile = objFSO.OpenTextFile(objFile.Path, ForReading)
'Get file contents - exclude end tag '
Do Until objCurrentFile.AtEndOfStream
strLine = objCurrentFile.ReadLine
If InStr(strLine, strSearchTerm) = 0 Then
strNewContents = strNewContents & strLine & vbCrLf
End If
Loop
objCurrentFile.Close
objCurrentFile = nothing
'Write new file contents to existing file '
Set objNewFile = objFSO.OpenTextFile(objFile.Path, ForWriting) 'PROBLEM LINE '
objNewFile.Write strNewContents
objNewFile.Close
objNewFile = nothing
Next
The file is read-only.
Try adding this before you open the text file for writing. If the file is read-only it will remove the read-only attribute.
IsReadOnly = False
IF objFile.Attributes AND 1 Then
objFile.Attributes = objFile.Attributes - 1
IsReadOnly = True
End If
Then add this when you are done writing to the file. If the file was read-only set it back to read-only.
If IsReadOnly Then
objFile.Attributes = objFile.Attributes + 1
IsReadOnly= False
End If
I found the issue. I was opening the text file and then copying it to another folder and then performing more operations on the file before closing the stream.
Once i moved the copy file code to before i opened the stream it works perfectly.
Thanks for the help though, i'll use your code in the future to be safe when working with text files.
you can try givin total control permission to the folder where is the the file to read.