I have the following script which is gathering all of the information I need but I was wondering how I alter it to print all of the results that are displayed in the windows to a list of some sort? I would like to manipulate this data in excel.
Dim arrHeaders(35)
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace("C:directory")
For i = 0 to 34
arrHeaders(i) = objFolder.GetDetailsOf(objFolder.Items, i)
Next
For Each strFileName in objFolder.Items
For i = 0 to 34
Wscript.Echo i & vbtab & arrHeaders(i) _
& ": " & objFolder.GetDetailsOf(strFileName, i)
Next
Next
Collect the detail information in another array and echo each record as a comma-separated line:
Dim arrData(35)
...
WScript.Echo Join(arrHeaders, ",")
For Each strFileName in objFolder.Items
For i = 0 to 34
arrData(i) = objFolder.GetDetailsOf(strFileName, i)
Next
WScript.Echo Join(arrData, ",")
Next
That way you can redirect the output to a CSV file by running the script with cscript.exe like this:
cscript //NoLogo "C:\path\to\your.vbs" > "C:\path\to\your.csv"
The CSV file can then be opened with Excel.
Another option is to use the FileSystemObject to write the output file from within the script:
Dim arrData(35)
...
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("C:\path\to\your.csv", 2, True)
f.WriteLine Join(arrHeaders, ",")
For Each strFileName in objFolder.Items
For i = 0 to 34
arrData(i) = objFolder.GetDetailsOf(strFileName, i)
Next
f.WriteLine Join(arrData, ",")
Next
f.Close
You don't need to modify the script to send the output to a file. Just open a console, navigate to script location and run the script, redirecting the output from console to a file
myvbscript.vbs > myoutputfile.txt
See:
http://www.microsoft.com/resources/documentation/windows/xp/all/proddocs/en-us/redirection.mspx?mfr=true
Related
I need a quick script do two parts.
Run a windows executable
Delete files within a folder and subfolders (*.jpg, *.img).
The first part of the below script works (running the executable) but I am getting stuck on part 2. I get
Cannot use parentheses when calling a sub
The error is on the line with the RecursiveDelete call. I actually cut and pasted that code from another SO question. I have googled the error but still don't understand.
Can anybody know how to get this script working?
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & "C:\Users\acer\Desktop\CT\process.exe" & Chr(34), 0
Set WshShell = Nothing
Dim PicArray(2)
Dim p
PicArray(1) = "*.jpg"
PicArray(2) = "*.img"
For p = 1 To 2
RecursiveDelete ("D:\pictures", PicArray(p))
Next p
Private Sub RecursiveDelete(ByVal Path As String, ByVal Filter As String)
Dim s
For Each s In System.IO.Directory.GetDirectories(Path)
try
RecursiveDelete(s, Filter)
catch dirEx as exception
debug.writeline("Cannot Access " & s & " : " & dirEx.message
end try
Next
For Each s In System.IO.Directory.GetFiles(Path, Filter)
try
System.IO.File.Delete(s)
catch ex as exception
debug.writeline("Cannot delete " & s & " : " & ex.message)
end try
Next
End Sub
Update: Revised answer from Hackoo that works great.
Option Explicit
Dim fso,RootFolder, wshShell
set fso = CreateObject("Scripting.FileSystemObject")
RootFolder = "D:\pictures"
Set RootFolder = fso.GetFolder(RootFolder)
Call RecursiveDelete(RootFolder)
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & "C:\process.exe" & Chr(34), 0
Set WshShell = Nothing
'*****************************************************************************
Function RecursiveDelete(Folder)
Dim File,MyFile,Ext,i,SubFolder
Set Folder = fso.GetFolder(Folder)
For each File in Folder.Files
Set MyFile = fso.GetFile(File)
Ext = Array("iMG","JPG")
For i = LBound(Ext) To UBound(Ext)
If LCase(fso.GetExtensionName(File.name)) = LCase(Ext(i)) Then
MyFile.Delete()
Exit For
end if
Next
Next
For each SubFolder in Folder.SubFolders
Call RecursiveDelete(SubFolder)
Next
End Function
'*****************************************************************************
Try like this way :
Option Explicit
Dim fso,RootFolder
set fso = CreateObject("Scripting.FileSystemObject")
RootFolder = "D:\pictures"
Set RootFolder = fso.GetFolder(RootFolder)
Call RecursiveDelete(RootFolder)
Msgbox "Pictures Cleaned !",vbInformation,"Pictures Cleaned !"
'*****************************************************************************
Function RecursiveDelete(Folder)
Dim File,MyFile,Ext,i,SubFolder
Set Folder = fso.GetFolder(Folder)
For each File in Folder.Files
Set MyFile = fso.GetFile(File)
Ext = Array("jpg","img")
For i = LBound(Ext) To UBound(Ext)
If LCase(fso.GetExtensionName(File.name)) = LCase(Ext(i)) Then
MyFile.Delete()
Exit For
end if
Next
Next
For each SubFolder in Folder.SubFolders
Call RecursiveDelete(SubFolder)
Next
End Function
'*****************************************************************************
Instead of passing the array item into RecursiveDelete, obtain the contents of the array item into a variable within the loop, and pass that variable instead.
Code would be similar to this- did not have a chance to test syntax.
For p = 1 To 2
Dim PicItem
PicItem = PicArray(p)
RecursiveDelete ("D:\pictures", PicItem )
Next p
I am using the following VBscript to get the total row count from my csv files. I need help in exporting the returned line count to a csv which will have two columns Name and Count name will be anything and the count is the returned count.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments
myFile = objArgs(0)
Set objFile = objFSO.OpenTextFile(myFile,1)
Do Until objFile.AtEndOfLine
line = objFile.Line
objFile.ReadLine
Loop
WScript.Echo "Line count of", myFile , "is", line
The way i would like to call the script would be:
Cscript 'vbscript_name' file_name_to_count 'custom_name' 'export_count.csv'
Thanks
Maybe I not see where is the break, as you only need to create new file and write just 2 lines in, but it w'd be something like this:
Set objFile = objFSO.OpenTextFile(objArgs(2), 2, True)
objFile.WriteLine "Name,Count"
objFile.WriteLine objArgs(1) & "," & line
objFile.Close
And just to become more friendly, here is the whole deal:
Set objArgs = WScript.Arguments
iLinesCount = FileLinesCount(objArgs(0))
DumpResult objArgs(2), objArgs(1), iLinesCount
WScript.Echo "File: " & objArgs(0) & " has " & iLinesCount & " lines"
Function FileLinesCount(strFileName)
With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile(strFileName, 1)
Do Until .AtEndOfStream
Call .ReadLine
Loop
FileLinesCount = .Line
End With
End With
End Function
Sub DumpResult(strFileName, strCustomName, iCount)
With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile(strFileName, 2, True)
.WriteLine "Name,Count"
.WriteLine strCustomName & "," & iCount
End With
End With
End Sub
Also it's good to add error checks for your command line arguments, but I live this simple task to you, cheers!
P.S. I suppose you'll prefer to append your count data to existing file instead of creating new file for each counted source file. If so, you have a very little work on DumpResult function, just need to open the file for appending (ForAppending = 8) and add "header" (column names) only then needs (i.e. when the file is newly created):
' modified version w`d be:
Sub DumpResult(strFileName, strCustomName, iCount)
With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile(strFileName, 8, True)
If .Line = 1 Then ' new empty file
.WriteLine "Name,Count" ' add column names
End If
.WriteLine strCustomName & "," & iCount
End With
End With
End Sub
I have a batch script that does the following tasks.
1. Create a backup folder
2. Zip specific files (text files in .log format) and move zipped files to backup folder
3. Delete the original files after moving
To accomplish the 2nd task, I'm writing the commands into VBScript file from batch script like below and then executing the VBScript at the end of batch script.
echo Option Explicit >> zipIt.vbs
REM remaining commands
CScript zipIt.vbs
The batch script successfully performs all 3 tasks for a file of size 100 MB.
But fails at VBScript command for file of size 1 GB. Following error is thrown at command prompt
C:\Users\Administrator\Desktop\zipIt.vbs(18, 1) Microsoft VBScript runtime error
: Permission denied
Below is the content of zipIt.vbs Written line numbers here for convenience.
1. Option Explicit
2. Dim FileToZip, Result
3. Dim oShell
4. Dim file
5. Dim oFileSys
6. Dim winShell
7. FileToZip = "C:\Program Files\logs\File_2013-04-29.log"
8. Result = "C:\Program Files\logs\File_2013-04-29.log.zip"
9. Set oShell = CreateObject("WScript.Shell")
10. Set oFileSys = CreateObject("Scripting.FileSystemObject")
11. Set file = oFileSys.CreateTextFile(Result, True)
12. file.Write "PK" & Chr(5) & Chr(6) & String(18, 0)
13. file.Close
14. Set file = nothing
15. set winShell = createObject("shell.application")
16. winShell.namespace(Result).CopyHere FileToZip
17. wScript.Sleep(5000)
18. oFileSys.DeleteFile FileToZip
Getting the same error if VBScript is run alone. Is it because of large file size?
This is most definitely a problem with memory, seeing as applications are capped at a maximum of 2GB, within windows at least, it is most likely an issue of the program trying to access memory that it was not allocated.
Alternative solution
Split large log files in little chunks:
BreakFile = "C:\Users\Administrador\Desktop\Test.txt"
limit = 400000 ' Bytes
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(Breakfile, 1)
FiletoSplit = objFSO.GetFileName(BreakFile)
FolderDest = Mid(objFSO.GetAbsolutePathName(BreakFile),1,Len(objFSO.GetAbsolutePathName(BreakFile))-(Len(FiletoSplit)))
FileSplitName = objFSO.GetBaseName(BreakFile)
dtmStart = Now()
Set objFile = objFSO.OpenTextFile(Breakfile, 1)
strContents = objFile.ReadAll
FileNum = 1
fname = FolderDest & FileSplitName & "Split " & FileNum & ".txt"
Set objFile1 = objFSO.OpenTextFile(fname, 2, True)
CountLines = 0
arrLines = Split(strContents, vbCrLf)
HeaderText = arrLines(0)
For i = 0 to ubound(arrlines)
strLine = arrLines(i) & vbCrLf
objFile1.Write strLine
If (Countlines) < limit Then
countlines = countlines + 1
ElseIf Countlines >= limit Then
objFile1.Close
Countlines = 0
FileNum = FileNum + 1
fname = FolderDest & FileSplitName & "Split " & FileNum & ".txt"
Set objFile1 = objFSO.OpenTextFile(fname, 2, True)
objFile1.Write HeaderText & vbCrLf
End If
Next
objFile.Close
dtmEnd = Now()
Then Zip it all together, and when extract the content, use a "Copy /B" batch command like this to join the chunks:
Copy /B "MyLog_Part*" "MyLog_Complete.log"
I'd like to write output from VBScript to notepad/wordpad in realtime. What's the best way to do this? I'm aware of sendkeys, but it requires that I parse the input for special commands.
SendKeys is the only method for writing to a third-party application in realtime. Why don't you use CScript and write to the standard output instead? That is what it is meant for.
' Force the script to run in the CScript engine
If LCase(Right(WScript.FullName, 11)) <> "cscript.exe" Then
strPath = WScript.ScriptFullName
strCommand = "%comspec% /k cscript " & Chr(34) & strPath & chr(34)
CreateObject("WScript.Shell").Run(strCommand)
WScript.Quit
End If
For i = 1 to 10
For j = 0 to 25
WScript.StdOut.WriteLine String(j, " ") & "."
WScript.Sleep 50
Next
For j = 24 to 1 Step - 1
WScript.StdOut.WriteLine String(j, " ") & "."
WScript.Sleep 50
Next
Next
Try this
Const fsoForWriting = 2
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Open the text file
Dim objTextStream
Set objTextStream = objFSO.OpenTextFile("C:\SomeFile.txt", fsoForWriting, True)
'Display the contents of the text file
objTextStream.WriteLine "Hello, World!"
'Close the file and clean up
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
I am searching for a VBScript that does a search and replace in files (e.g. 1.txt 2.xml).
I have file "1.txt" that inside there is the word "temporary" and I want to change it to "permanent".
Because I get this file a lot I need a script for it.
Every time that I try to write a script that contains open a txt file and the command replace, it doesn't.
I found a script that change this file with another file and does the change inside, but this is not what I am looking for.
Try this
If WScript.Arguments.Count <> 3 then
WScript.Echo "usage: Find_And_replace.vbs filename word_to_find replace_with "
WScript.Quit
end If
FindAndReplace WScript.Arguments.Item(0), WScript.Arguments.Item(1), WScript.Arguments.Item(2)
WScript.Echo "Operation Complete"
function FindAndReplace(strFilename, strFind, strReplace)
Set inputFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(strFilename, 1)
strInputFile = inputFile.ReadAll
inputFile.Close
Set inputFile = Nothing
Set outputFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(strFilename,2,true)
outputFile.Write Replace(strInputFile, strFind, strReplace)
outputFile.Close
Set outputFile = Nothing
end function
Save this in a file called Find_And_Replace.vbs, it can then be used at the command line like this.
[C:\]> Find_And_Replace.vbs "C:\1.txt" "temporary" "permanent"
*This method is case sensitive "This" != "this"
If you don't want to read the entire file into memory, you could use a temp file like this.
If WScript.Arguments.Count <> 3 then
WScript.Echo "usage: Find_And_replace.vbs filename word_to_find replace_with "
WScript.Quit
end If
FindAndReplace WScript.Arguments.Item(0), WScript.Arguments.Item(1), WScript.Arguments.Item(2)
WScript.Echo "Operation Complete"
function FindAndReplace(strFile, strFind, strReplace)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInputFile = objFSO.OpenTextFile(strFile,1)
strTempDir = objFSO.GetSpecialFolder(2)
Set objTempFile = objFSO.OpenTextFile(strTempDir & "\temp.txt",2,true)
do until objInputFile.AtEndOfStream
objTempFile.WriteLine(Replace(objInputFile.ReadLine, strFind, strReplace))
loop
objInputFile.Close
Set objInputFile = Nothing
objTempFile.Close
Set objTempFile = Nothing
objFSO.DeleteFile strFile, true
objFSO.MoveFile strTempDir & "\temp.txt", strFile
Set objFSO = Nothing
end function
You can try this version which doesn't slurp the whole file into memory:
Set objFS = CreateObject("Scripting.FileSystemObject")
strFile=WScript.Arguments.Item(0)
strOld=WScript.Arguments.Item(1)
strNew=WScript.Arguments.Item(2)
Set objFile = objFS.OpenTextFile(strFile)
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
if Instr(strLine,strOld)> 0 Then
strLine=Replace(strLine,strOld,strNew)
End If
WScript.Echo strLine
Loop
Usage:
c:\test> cscript //nologo find_replace.vbs file oldtext newtext