Aw man!
This is a VBScript that was supposed to change all the files in the directory that are named like
1229_002510 to 2010-12-29_002510
What ended up happening is the script never terminated.
After one pass through the file names, it KEPT GOING and prepended 2010- MULTIPLE TIMES until I killed the script.
The bug only appears if you launch the script through CScript at cmd.
(Launch with: cscript "filename.vbs")
So now I have a folderful of files like
2010-20-10-20-10-20-10-20-10-20-10-20-10-20-10-20-10-20-10-20-10-11-26_023335
Realize I'm a VBScript noob.
The script appears to work in test mode (just printing file names) but as soon as you have it work on actual files, it does exhibit the described behavior.
' shell script that changes dates like
' 1219_005530 to 2010-12-19_005530
' create a root filesystemobject:
Dim ofso
Set ofso = CreateObject( "Scripting.FileSystemObject" )
' create a folder object USING that root filesystem object
Dim folder
' that's the current directory
Set folder = ofso.GetFolder( "." )
' now, visit each file in the folder
Dim fileo
For Each fileo In folder.Files
dim originalName
originalName = CStr( fileo.Name )
' cut first 2 chars, prepend 2010-, re-add first 2 chars + "-"
dim monthNumber
monthNumber = Mid( originalName, 1, 2 )
' don't change the source file!
If Right( originalName, 3 ) = "vbs" Then
WSH.echo( "Not changing " & originalName )
Else
dim newName
newName = "2010-" & monthNumber & "-" & Mid( originalName, 3 )
WSH.echo( originalName )
WSH.echo( newName & " < CHANGED TO" )
' ONLY ENABLE THIS LINE ONCE DEBUGGING COMPLETE
'fileo.Name = newName
End If
Next
' PAUSE BEFORE EXIT
I dont know what you dit, but i copy/pasted your script and it works just as you intended. (Windows 7)
Edit: Try to set a max on the times the script may go tru the loop. That will fix it. Might be that the script sees the renamed files as new files, thus creating an infinite loop.
You can perform this task in 2 steps. First scan a directory for files and collect their names into array, and then run through this array and rename files. This should be more reliable.
And consider to switch to JScript. VBS is just ugly compared to it.
Related
I have a folder which contains various tif files.I am using a simple move command which reads as
move "Source path/File name" "Destination path/"
I have tried a command which reads as:
move "Source path/File 1, File 2. File 3" "Destination Path/"
I am looking for a similar formula which can help me out. The reason why this code is important for me
In a scenario where iam moving only one file to destination folder
In another scenario, I have to choose 3 or more files to another destination folder. If I do this with generic formula it takes a longer time to accomplish.
Please do suggest on this.
move "Source path/File 1, File 2. File 3" "Destination Path/"
In a scenario where I am moving only one file to destination folder.
In another scenario, I have to choose 3 or more files to another destination folder.
Example:
Sample
If I do this with generic formula it takes a longer time to accomplish.
You might try the code below.
Sub MoveFiles()
Dim DestinationPath As String
Dim SourcePath As String
Dim FileNames As String
Dim Sp() As String
Dim i As Integer
SourcePath = Environ("USERPROFILE") & "\Desktop"
DestinationPath = "H:\TestFolder"
FileNames = "File1.txt,File2.txt,File3.txt"
If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"
If Right(DestinationPath, 1) <> "\" Then DestinationPath = DestinationPath & "\"
If Len(FileNames) Then
Sp = Split(FileNames, ",")
For i = 0 To UBound(Sp)
Sp(i) = Trim(Sp(i))
If Len(Dir(SourcePath & Sp(i))) Then
Name SourcePath & Sp(i) As DestinationPath & Sp(i)
End If
Next i
End If
End Sub
Set the Source and Destination paths according to your system. Enter as many or as few file names in one comma separated string. All named files will be moved if they exist at the SourcePath. If the destination path doesn't exist an error will occur.
I am writing a VBScript to try to compress multiple directories in different locations into the same Zip file.
The current solution I am using is to iterate over the directories I want to compress (of which there are currently 2), get the file objects and use the copyHere method to copy the source folder into a zip file with the proper header format.
That part seems to be working okay, the difficulty I am having is with the error checking. The only two solutions I have found online are to get the count of objects in the source and target directories and sleep until they are the same, or to check if the zip file is open for appending and sleep until it is.
The first option is easy with one directory but becomes much more tedious with multiple folders, not to mention that Windows will likely create an object in the target directory before it has finished copying and I am compressing files potentially over 10 GB so that solution won't work.
I had tried to implement the second solution but every time the loop got to the second call to CopyHere it would tell me that the zip file was corrupted from the first iteration. Is it not possible to compress very large files to a zip with VBScript?
Any other suggestions as to how I can error check that the compressing is done using VBScript would be very helpful.
Here is a Function Create_WinRar_Archive(Source,Target_Archive,Password) to compress a folder with rar.exe command line of Winrar.
We can call this function by two ways :
If you want create an archive without password, so we called it by this way :
Call Create_WinRar_Archive(Source,Target_Archive,"")
or if you want to set to this archive a password just we called it as :
Call Create_WinRar_Archive(Source,Target_Archive,Password)
And here is an example to compress the Pictures folder
Option Explicit
Dim ws,Source,Target_Archive,Password
Set ws = CreateObject("Wscript.Shell")
Source = ws.ExpandEnvironmentStrings("%userprofile%\pictures")
Target_Archive = "C:\BackupImages.rar"
Password = "123456"
Call Create_WinRar_Archive(Source,Target_Archive,Password)
Wscript.echo "All files are archived successfully !"
ws.run "Explorer " & Target_Archive
'******************************************************************************************************
Function Create_WinRar_Archive(Source,Target_Archive,Password)
'This function executes the command line
'version of WinRAR and reports whether
'the archive exists after WinRar exits.
'If it exists then it returns true. If
'not it returns an error message.
'------------------------------------------------------------------------------------
Dim oFSO,oShell,aScriptFilename,sScriptFilename
Dim sWorkingDirectory,ProgramFiles,sWinRarLocation
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Wscript.Shell")
'--------Find Working Directory--------
aScriptFilename = Split(Wscript.ScriptFullName, "\")
sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
'-------Ensure we can find Winrar.exe------
If oFSO.FileExists(sWorkingDirectory & " " & "Winrar.EXE") Then
sWinRarLocation = ""
ElseIf oFSO.FileExists(oShell.ExpandEnvironmentStrings("%ProgramFiles%\Winrar\rar.exe")) Then
sWinRarLocation = oShell.ExpandEnvironmentStrings("%programfiles%\Winrar\")
ElseIf oFSO.FileExists(oShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%\Winrar\rar.exe")) Then
sWinRarLocation = oShell.ExpandEnvironmentStrings("%programfiles(x86)%\Winrar\")
Else
Create_WinRar_Archive = "Error: Couldn't find Winrar.EXE"
Exit Function
End If
'--------------------------------------
'The Command "A" Means ==> add to archive
'To create a WinRar file with the specified name after command A (archive) and the switches -ep1 (exclude base directory from names) and -r (recursive)
If Password = "" Then
oShell.Run """" & sWinRarLocation & "rar.exe"" A -ep1 -r """ & _
Target_Archive & """ """ & Source & """",0,True
Else
'The -hp<password> switch: To use a password
oShell.Run """" & sWinRarLocation & "rar.exe"" A -ep1 -r -hp"&Password&" """ & _
Target_Archive & """ """ & Source & """",0,True
End If
If oFSO.FileExists(Target_Archive) Then
Create_WinRar_Archive = 1
Else
Create_WinRar_Archive = "Error: Creating archives failed !"
MsgBox Create_WinRar_Archive,16,Create_WinRar_Archive
End If
End Function
'****************************************************************************************************
The code below does 2 things, looks at all the files in a particular, determines if the files have .pdf extension. If any file doesn't, it fixes the extension and then moves all the files to another folder.
So far, this script does all of that great.
Problem is that 3 files with .txt extensions are always included with this list and we don't want the extensions for these files changed and we don't want them moved either.
The files are called index.txt, pending.txt and tableofcontents.txt.
Is this possible?
Here is the code I have so far and thanks a lot in advance.
Set FSO = CreateObject("Scripting.FileSystemObject")
Set pdfFolder = FSO.GetFolder( "E:\LOCS\FTP\Current\")
For Each fil In pdfFolder.Files
' check each file to be sure it fits the pattern
fname = fil.Name
suffix = LCase( Right( fname, 4 ) )
'prefix = Left( fname, 8 )
' so suffix has to be right:
If suffix = ".pdf" Then
newName = Mid( fname, 9 )
' Response.Write "Renaming '" & fname & "' to '" & newName & "'<br/>" & vbNewLine
fil.Move "E:\DOCs\PermLoc\" & newName
End If
Next
Try setting a breakpoint and stepping through the code to see what suffixes are being compared and if ".txt" = ".pdf" is returning true and entering the If statement.
I have a vbscript that is used to rename files. What I need to implement into the script is something that deletes the "new file" if it already exists.
For example: I have a batch of files that are named like this 11111111.dddddddd.pdf where the files get renamed to 11111111.pdf. The problem is that when I rename to the 11111111.pdf format I end of with files that are duplicated and then makes the script fail because you obviously cant have 2 files with the same name. I need it to rename the first one but then delete the others that are renamed the same.
Here is what I have so far for my IF statement but it doesnt work and I get and error that says "Type mismatch: 'FileExists". I am not sure how to get this part of the code to execute the way I would like. Any help or suggestions would be greatly appreciated.
dim infolder: set infolder = fso.GetFolder(IN_PATH)
dim file
for each file in infolder.files
dim name: name = file.name
dim parts: parts = split(name, ".")
dim acct_, date_
acct_ = parts(0)
date_ = parts(1)
' file format of a.c.pdf
if UBound(parts) = 2 then
' rebuild the name with the 0th and 2nd elements
dim newname: newname = acct_ & "." & parts(2)
' use the move() method to effect the rename
file.move fso.buildpath(OUT_PATH, newname)
if newname = FileExists(file.name) Then
newname.DeleteFile()
end if
end if
next 'file
You're close, you just need to delete the file before trying to over-write it.
dim infolder: set infolder = fso.GetFolder(IN_PATH)
dim file: for each file in infolder.Files
dim name: name = file.name
dim parts: parts = split(name, ".")
if UBound(parts) = 2 then
' file name like a.c.pdf
dim newname: newname = parts(0) & "." & parts(2)
dim newpath: newpath = fso.BuildPath(OUT_PATH, newname)
' warning:
' if we have source files C:\IN_PATH\ABC.01.PDF, C:\IN_PATH\ABC.02.PDF, ...
' only one of them will be saved as D:\OUT_PATH\ABC.PDF
if fso.FileExists(newpath) then
fso.DeleteFile newpath
end if
file.Move newpath
end if
next
fileExists() is a method of FileSystemObject, not a global scope function.
You also have an issue with the delete, DeleteFile() is also a method of FileSystemObject.
Furthermore, it seems you are moving the file and then attempting to deal with the overwrite issue, which is out of order. First you must detect the name collision, so you can choose the rename the file or delete the collision first. I am assuming for some reason you want to keep deleting the new files until you get to the last one, which seemed implied in your question.
So you could use the block:
if NOT fso.FileExists(newname) Then
file.move fso.buildpath(OUT_PATH, newname)
else
fso.DeleteFile newname
file.move fso.buildpath(OUT_PATH, newname)
end if
Also be careful that your string comparison with the = sign is case sensitive. Use strCmp with vbText compare option for case insensitive string comparison.
IF both POS_History_bim_data_*.zip and POS_History_bim_data_*.zip.trg exists in Y:\ExternalData\RSIDest\ Folder then Delete File Y:\ExternalData\RSIDest\Target_slpos_unzip_done.dat
Open App.Path & "\Folder\" & str(0) For Output
Seems to get a path not found however if directly before that I do
MsgBox App.Path & "\Folder\" & str(0)
It Provides the correct directory/filename that I want
and if I replace that string with the direct path in quotes it works fine however that won't be very good for other users of my app :( Anyone know why this doesn't work?
You can open a file that doesn't exist. I tried it with:
Open "c:\temp\test.txt" & Str(0) For Output As #1
Close #1
When it ran it created c:\temp\test.txt 0
Note that I added "As #1" to the Open statement, and taht Str(0) adds a leading space for the optional minus sign (CStr(0) doens't add a leading space)
Comment: You can open a file that doesn't exist.
Only true if your folder exist. If both your folder and file does not exist, it will give a "path not found" error.
Here something easy i made for you:
Function CreateLog(Destination As String, MyMessage As String)
Dim PathToCreate, FolderPath, FileName As String
'Check for Unnecessary Spaces
Destination = Trim(Destination)
FolderStr = Destination
'Gather only FolderPath of Destination
Do
FolderStr = Mid(FolderStr, 1, Len(FolderStr) - 1)
Loop Until Right(FolderStr, 1) = "\" Or Len(FolderStr) < 1
'Gather only FileName
FileName = Mid(Destination, Len(FolderStr) + 1, Len(Destination) - Len(FolderStr))
'If the path does not exist than create it
'Recursive approach
For Each Folder In Split(FolderStr, "\")
If InStr(1, Folder, ":") = 0 Then
PathToCreate = PathToCreate & "\" & Folder
Else
PathToCreate = Folder
End If
If fso.FolderExists(PathToCreate) = False And PathToCreate <> "" Then
fso.CreateFolder PathToCreate
End If
Next
'Open file and add the message in it
Open PathToCreate & "\" & FileName & ".txt" For Append As #1
Print #1, MyMessage
Close #1
End Function
Usage:
CreateLog "D:\Test\NewTest\NewFolder\AnotherFolder\atlastthefile.abcdefg", "Hello!"
Doesnt matter what fileExtention given cause ill add ".txt" anyways..