I have a script that connects to Oracle, runs a query, and saves the output to a CSV. Is there an easy way of make a copy of the file using the existing TextStream object?
' Execute query
Set objResultSet = objConnect.Execute(strSql)
' Create a filename to save query to
strTimeStamp = DatePart("yyyy",Date) & Right("0" & DatePart("m",Date), 2) & _
Right("0" & DatePart("d",Date), 2) & Right("0" & Hour(Now), 2) & _
Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
strOutputFilename = strTimeStamp & ".csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = objFSO.CreateTextFile(strOutputFilename, True)
' Loop through each row of recordset and output to jobcode download file
objResultSet.MoveFirst
Do While Not objResultSet.EOF
objOutputFile.WriteLine (objResultSet(0) & "," & objResultSet(1))
objResultSet.MoveNext
Loop
You could sort-of copy the file by creating files in both locations and writing the content to both files simultaneously. Other than that you'll have to use the Copy or CopyFile method. TextStream objects only have methods for manipulating the content of a file, not its location.
Related
I'm using the following code to rotate log files. If the Log.txt file is different than the current date-time (based on file property .DateCreated), the file is moved using the .DateCreated value to rename it and then a new Log.txt file is created but the new file date created value is the same as the moved (archived) file.
If the script is run again a few seconds later it fails to move the Log.txt file as an archived version already exist.
Option Explicit
Dim objFS: Set objFS = CreateObject("Scripting.FileSystemObject")
Dim strLogPath: strLogPath = "C:\Logs"
Dim strLogFQFN: strLogFQFN = objFS.BuildPath(strLogPath, "Log.txt")
If objFS.FileExists(strLogFQFN) <> True Then
WScript.Quit
End If
'As file exists, validate if archive is needed
Dim objFile: Set objFile = objFS.GetFile(strLogFQFN)
Dim dtmLog: dtmLog = objFile.DateCreated'DateValue(objFile.DateCreated)
Dim dtmNow: dtmNow = Now 'Date
Set objFile = Nothing
WScript.Echo dtmLog
WScript.Echo dtmNow
If (dtmLog <> dtmNow) Then
Dim tsDate: tsDate = DatePart("yyyy", dtmLog) & "-" & Right("0" & DatePart("m", dtmLog), 2) & "-" & Right("0" & DatePart("d", dtmLog), 2)
Dim tsTime : tsTime = Right("0" & Hour(dtmLog), 2) & Right("0" & Minute(dtmLog), 2) & Right("0" & Second(dtmLog), 2)
Call objFS.MoveFile(strLogFQFN, objFS.BuildPath(strLogPath, tsDate & "T" & tsTime & ".txt"))
Call objFS.CreateTextFile(strLogFQFN, False)
End If
1st run - Original file Log.txt moved to 2022-03-11T014931.txt and new Log.txt created
1st and 2nd run date-time values and error
Thanks
Based on LesFerch comment I have tested adding a delay of 16 seconds to overcome the default Tunneling cache time and that resolved the issue using the C drive.
Call objFS.MoveFile(strLogFQFN, objFS.BuildPath(strLogPath, tsDate & "T" & tsTime & ".txt"))
WScript.Sleep 16000
Call objFS.CreateTextFile(strLogFQFN, False)
I am trying to create a textfile in a temp directory...
I don't understand what I am doing wrong...
My Error is:
Microsoft VBScript runtime error '800a004c'
Path not found
/racklabels/desktop/printLabel.asp, line 128
There is a temp directory on my server I am running this from...
strFileNameQAD = "C:\temp\" & strFileNameRBB
'Create the files, write to them & close them.
If bBackFlush = True Then
Set filQAD = objFileSys.CreateTextFile(strFileNameQAD)
filQAD.WriteLine ("H::" & strPart & strLocation & strSite & strQty & strSerial & strRef & strUserID & strAccount & strSubAccount & strCostCenter & strEffDate & strYes)
filQAD.WriteLine ("D::" & strFromLocation & strNo & strUserID)
filQAD.Close
Set filQAD = Nothing
End If
The FileSystemObject is complaining about the path contained in the strFileNameQAD, try placing a Response.Write strFileNameQAD : Response.Flush before the offending line to see what strFileNameQAD outputs as.
Note: Response.Flush causes the server to write the response headers and buffer, so even if your script errors the output will be shown first.
strFileNameQAD = "C:\temp\" & strFileNameRBB
'Create the files, write to them & close them.
If bBackFlush = True Then
'Output strFileNameQAD variable to check content
Response.Write strFileNameQAD : Response.Flush
Set filQAD = objFileSys.CreateTextFile(strFileNameQAD)
filQAD.WriteLine ("H::" & strPart & strLocation & strSite & strQty & strSerial & strRef & strUserID & strAccount & strSubAccount & strCostCenter & strEffDate & strYes)
filQAD.WriteLine ("D::" & strFromLocation & strNo & strUserID)
filQAD.Close
Set filQAD = Nothing
End If
Does the strFileNameQAD variable contain the expected path? My guess would be that strFileNameRBB is empty so the FileSystemObject sees C:\temp\ but no file to create, hence the error.
Problem:
This script below is looping through 4+ million files and retrieving file property information to determine what can be purged. The current process is already using 20+GB of RAM and is only half finished.
I've been creating a large batch file to write each subfolders contents to a new text file. This isn't practical because its time consuming and this is the first of several servers that I will be running this process on.
Questions:
-Is it possible to create a new file to write to based on the subfolder loop? (using the object property in place of the file doesn't appear to do the trick)
-Or is is possible to write the contents to the file, then clear the previous data from my temporary memory?
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "C:\Test"
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
On Error Resume Next
If Err Then
MyFile.Write "Error accessing " & objFile & ": " & Err.Description & vbCrLf
Err.Clear
Else
Q="""" 'Wrap quotes around string
strFilePath = Q & objFile.Path & Q
strFileName = Q & objFile.Name & Q
strFileSize = objFile.Size
strFileType = Q & objFile.Type & Q
strFileDateCreated = objFile.DateCreated
strFileDateLastAccessed = objFile.DateLastAccessed
strFileDateLastModified = objFile.DateLastModified
Set objWMIService = GetObject("winmgmts:")
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting=""" & replace(objFile, "\", "\\") & """")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
strFileOwner = Q & objSD.Owner.Domain & "\" & objSD.Owner.Name & Q
Else
strFileOwner = Q & "Couldn't retrieve security descriptor." & Q
End If
' CreatedDiff = DateDiff("yyyy",strFileDateCreated,Now)
' AccessedDiff = DateDiff("yyyy",strFileDateLastAccessed,Now)
' ModifiedDiff = DateDiff("yyyy",strFileDateLastModified,Now)
' MaxTime = 3 'Max time in years. For days change "yyyy" to "d"
' If (CreatedDiff >= MaxTime) AND (AccessedDiff >= MaxTime) AND (ModifiedDiff >= MaxTime) Then
MyFile.Write strFilePath & "~|~" &_
strFileName & "~|~" &_
strFileSize & "~|~" &_
strFileType & "~|~" &_
strFileDateCreated & "~|~" &_
strFileDateLastAccessed & "~|~" &_
strFileDateLastModified & "~|~" &_
strFileOwner & vbCrLf
' End If
End If
Next
ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
On Error Resume Next
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
On Error Resume Next
If Err Then
MyFile.Write "Error accessing " & objFile & ": " & Err.Description & vbCrLf
Err.Clear
Else
Q="""" 'Wrap quotes around string
strFilePath = Q & objFile.Path & Q
strFileName = Q & objFile.Name & Q
strFileSize = objFile.Size
strFileType = Q & objFile.Type & Q
strFileDateCreated = objFile.DateCreated
strFileDateLastAccessed = objFile.DateLastAccessed
strFileDateLastModified = objFile.DateLastModified
Set objWMIService = GetObject("winmgmts:")
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting=""" & replace(objFile, "\", "\\") & """")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
strFileOwner = Q & objSD.Owner.Domain & "\" & objSD.Owner.Name & Q
Else
strFileOwner = Q & "Couldn't retrieve security descriptor." & Q
End If
' CreatedDiff = DateDiff("yyyy",strFileDateCreated,Now)
' AccessedDiff = DateDiff("yyyy",strFileDateLastAccessed,Now)
' ModifiedDiff = DateDiff("yyyy",strFileDateLastModified,Now)
' MaxTime = 3 'Max time in years. For days change "yyyy" to "d"
' If (CreatedDiff >= MaxTime) AND (AccessedDiff >= MaxTime) AND (ModifiedDiff >= MaxTime) Then
MyFile.Write strFilePath & "~|~" &_
strFileName & "~|~" &_
strFileSize & "~|~" &_
strFileType & "~|~" &_
strFileDateCreated & "~|~" &_
strFileDateLastAccessed & "~|~" &_
strFileDateLastModified & "~|~" &_
strFileOwner & vbCrLf
' End If
End If
Next
ShowSubFolders Subfolder
Next
End Sub
It's a bit difficult to tell you how to do it since you've not provided your full script, as you reference objects that were not instantiated in the code you provided.
Yes you can write each folder's output to a new file as well as free memory. You need to change your script's structure a bit though. I was doing it for you until I came across more undefined objects and gave up, so instead I'll just tell you what to do.
You don't need two subs, just one will do. Here's the outline of the structure:
Dim fso, startfolder
Set fso = CreateObject("Scripting.FileSystemObject")
startfolder = "C:\temp"
GetFileInfo startfolder
Sub GetFileInfo(folderpath)
On Error Resume Next
Dim file, logpath, logfile, folder
logpath = "C:\log\" & fso.GetBaseName(folderpath) & ".log" ' C:\log folder must exist; but of course edit path and file name conventions as desired
Set logfile = fso.OpenTextFile(logpath, 2, True)
If Err Then EchoAndQuit "Failed to create log " & logpath & ": " & Err.Description
' Write the file info in current folder
For Each file In fso.GetFolder(folderpath).Files
logfile.WriteLine file.Name ' file/security info
Next
'Set x = Nothing (Set objects instantiated in this sub to nothing to release memory)
' Now the recursive bit
For Each folder In fso.GetFolder(folderpath).SubFolders
GetFileInfo(folder.Path)
Next
On Error GoTo 0
End Sub
Sub EchoAndQuit(msg)
MsgBox msg, 4096 + 16, "Failed"
WScript.Quit
End Sub
One problem with this is you'll get an access denied error if you have multiple folder with the same name - I'll leave it to you to work out some check/naming convention to avoid this. (You could get around it by setting logfile = nothing, but you'll overwrite existing log files if there are multiple folders with the same name. So that's something you could work out, some log file check/naming convention to get around the duplicate name issue, then you could destroy the object if you wanted.)
I used to use a line in Robocopy that would allow me to copy all folders in a folder INCLUDING the parent folder, I.E all files/folders in the Blackberry folder INCLUDING the Blackberry folder itself, else without it it would just copy the files within and dump them in the backup location...
The code used was;
for %%a in ("%source%") do SET destination="Backups\%date%\%%~nxa"
Now in VB Script I've got;
sSource = Chr(34) & objFolder.self.Path & Chr(34) & " "
So how would I go about having VB Script (which still calls Robocopy) use the above so that when it backs up it will include the PARENT folder as well?
This was the code I had; Converting Robocopy Batch To VB Script
Thanks in advance!
EDIT: The current content of my script file;
Dim BrowseBackupSource
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Please browse to the folder you would like to backup.", 1, "C:\")
If objFolder Is Nothing Then
Wscript.Quit
End If
wscript.Echo "folder: " & objFolder.title & " Path: " & objFolder.self.path
Dim BrowseBackupLocation
Set objShell = CreateObject("Shell.Application")
Set objDest = objShell.BrowseForFolder(0, "Please browse to the folder you would like to save the backup to.", 1, "C:\")
If objDest Is Nothing Then
Wscript.Quit
End If
wscript.Echo "folder: " & objDest.title & " Path: " & objDest.self.path
sCmd = "%windir%\System32\Robocopy.exe "
sDate = Day(Now) & "-" & Month(Now) & "-" & Year(Now)
sTime = Hour(Now) & "-" & Minute(Now) & "-" & Second(Now)
sSource = Chr(34) & objFolder.self.Path & Chr(34) & " "
sDestination = Chr(34) & objDest.self.Path & Chr(34) & " "
sSwitches = "/E /Log:"& sTime &".txt"
Set objShell = CreateObject("Wscript.Shell")
objShell.Run(sCmd & sSource & sDestination & sSwitches)
Well, if you need the path to the parent folder to set as root of copy:
dim parentFolderPath
parentFolderPath = WScript.CreateObject("Scripting.FileSystemObject").GetFolder(objFolder.self.Path).ParentFolder.Path
EDIT
You need the name of the selected source directory added to the path of the selected destination so
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
sSourceFolderName = fso.GetFolder(objFolder.self.Path).Name
sDestination = Chr(34) & objDest.self.Path & "\" & sSourceFolderName & Chr(34)
Robocopy will handle the target directory creation
If you want to create a copy of a particular folder for backup, why don't you simply copy that folder to the backup destination and be done with it?
Set fso = CreateObject("Scripting.FileSystemObject")
Set app = CreateObject("Shell.Application")
dst = "C:\backups\" & Year(Now) & "\" & Month(Now) & "\" & Day(Now)
CreatePath dst
Set fldr = app.BrowseForFolder(0, "Example", 1, "c:\Programs")
fso.CopyFolder fldr.Self.Path, dst & "\", True
Sub CreatePath(p)
If Not fso.FolderExists(p) Then
CreatePath fso.GetParentFolderName(p)
fso.CreateFolder p
End If
End Sub
I want to copy files from one folder to another which falls between a specific date range using VBS.
for example i want to copy files from 06/11/2009 to 06/12/2010.
How can I do that in VB script.
Is WMI an option? If so, here's a sample script based on the one from the Hey, Scripting Guy! article How Can I Delete All Files Older Than a Specified Date?:
strComputer = "."
strFolder = "C:\FromFolder"
strNewFolder = "C:\ToFolder"
strDateFrom = "20090611000000.000000+00" ' 06/11/2009
strDateTo = "20100612000000.000000+00" ' 06/12/2010
Set oWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colFiles = oWMI.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & strFolder & "'} WHERE " _
& "ResultClass = CIM_DataFile")
For Each oFile in colFiles
If oFile.CreationDate > strDateFrom And oFile.CreationDate < strDateTo Then
'WScript.Echo "Full path: " & oFile.Name
'WScript.Echo "Creation date: " & oFile.CreationDate
oFile.Copy strNewFolder & "\" & oFile.FileName & "." & oFile.Extension
oFile.Delete
End If
Next
Here's a slightly different variant where date checks are included in the WMI query:
strComputer = "."
strDateFrom = "20090611000000.000000+00" ' 06/11/2009
strDateTo = "20100612000000.000000+00" ' 06/12/2010
strNewFolder = "C:\ToFolder"
iFlags = 48
Set oWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colFiles = oWMI.ExecQuery( _
"SELECT * FROM CIM_DataFile" & _
" WHERE Drive = 'C:' AND Path = '\\FromFolder\\'" & _
" AND CreationDate >= '" & strDateFrom & "'" & _
" AND CreationDate <= '" & strDateTo & "'" _
,,iFlags)
For Each oFile in colFiles
'WScript.Echo "Full path: " & oFile.Name
'WScript.Echo "Creation date: " & oFile.CreationDate
oFile.Copy strNewFolder & "\" & oFile.FileName & "." & oFile.Extension
oFile.Delete
Next
A few notes:
The script is non-recursive, that is, it only moves files from the source folder itself and not its subfolders.
Dates are specified in the UTC format. More info about this format is in the article I linked to.
WMI doesn't include methods for moving files and folders, so the script copies then deletes the files.
You can use the FileSystemObject. The following will get the date a file was created:
Dim fso, myfile, d
Set fso = CreateObject("Scripting.FileSystemObject")
Set myfile = fso.GetFile("something.dat")
d = myfile.DateCreated
MsgBox d
Read more here.
Here is an example of how to loop through the files in a given folder. For each file, you can check the date, decide whether you like it, and if so copy the file.