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.
Related
Original question:
I am quite unskillful with VBScript but would need an efficient solution for saving me lots of time selecting and copying files manually:
I have a folder with thousands raster files containing values of daily temperature for a certain area, altogether covering a period of 30 years.
In order to calculate monthly means out of 30 or 31 files per month (within a programme for geospatial data), I need to copy them into separate folders, e. g. the files from 2000 January 1 to 31 (named tx_20000101, tx_20000102 and so forth) into a folder named T_01_Jan_2000 and accordingly for all other months and years.
So I need a script, that searches for different text strings (YYYYMM) within all file names and moves the matched files into the given folder (for each search string a separate folder).
How could that be accomplished with VBScript?
With examples found in forums (mainly this: https://stackoverflow.com/a/29001051/6093207), I have come so far:
Option Explicit
Sub Dateien_verschieben()
Dim i
Dim FSO : Set fso = CreateObject("Scripting.FileSystemObject")
Dim Quelle : Set Quelle = FSO.GetFolder("C:\Users\…\Temperature")
Dim Ziel1 : Set Ziel1 = FSO.GetFolder("C:\Users\…\Temperature\T_01_Jan\T_01_Jan_2000")
Dim Ziel2 : Set Ziel2 = FSO.GetFolder("C:\Users\…\Temperature\T_02_Feb\T_02_Feb_2000")
…
Dim Ziel12 : Set Ziel12 = FSO.GetFolder("C:\Users\…\Temperature\T_12_Dez\T_12_Dez_2000")
Dim Str1, Str2, Str3, Str4, Str5, Str6, Str7, Str8, Str9, Str10, Str11, Str12
Str1 = "200001"
Str2 = "200002"
…
Str12 = "200012"
i = 0
For Each file in Quelle.files
x = fso.getbasename(file)
If instr(lcase(x), Str1) Then
i = i+1
If fso.fileexists(Ziel1 & "\" & file.name) Then
fso.deletefile Ziel1 & "\" & file.name, True
End If
fso.movefile Quelle & "\" & file.name, Ziel1
ElseIf instr(lcase(x), Str12) Then 'I have omitted the other ElseIf statements here for reasons of clarity
i = i+1
If fso.fileexists(Ziel12 & "\" & file.name) Then
fso.deletefile Ziel12 & "\" & file.name, True
End If
fso.movefile Quelle & "\" & file.name, Ziel12
End If
Next
If i>0 Then
wscript.echo i&" files moved to path " & vbcrlf & Quelle
wscript.quit()
End If
wscript.echo "No matches found"
End Sub
However, I get different errors like 800A0414 and 800A0046, and did not get the script running yet as intended.
Any suggestions for correcting the code or for more efficent ways of scripting are welcome.
Edited question:
Having a folder with several thousands netCDF-files containing values of daily temperature for a certain area, altogether covering a period of 30 years, how is it possible to move them into separate folders monthwise?
The month folders should contain subfolders for the respective year.
So the files are named tx_20000101.nc, tx_20000102.nc and so forth and are altogether in the folder Temperature.
Now all files from January should come into a folder name T_01, which contains subfolders named T_01_1991, T_01_1992 and so on, accordingly for all other months and years.
How can this be accomplished by VBScript?
The solution (thanks to #Les Ferch):
Move = True 'Set to False for Copy
SrcDir = ".\Temperature" Set oFSO = CreateObject("Scripting.FileSystemObject")
Set Source = oFSO.GetFolder(SrcDir)
For Each File in Source.Files
FileName = Right(File,11)
YYYY = Mid(FileName,1,4)
MM = Mid(FileName,5,2)
MonthDir = SrcDir & "\T_" & MM & "\"
YearDir = MonthDir & "T_" & MM & "_" & YYYY & "\"
If Not oFSO.FolderExists(MonthDir) Then oFSO.CreateFolder(MonthDir)
If Not oFSO.FolderExists(YearDir) Then oFSO.CreateFolder(YearDir)
If Move Then oFSO.MoveFile(File),YearDir Else oFSO.CopyFile(File),YearDir
Next
I'm trying to create a VBScript to copy every X minutes files from location A to location B.
My conditions are: copy all new files (that don't exist in the destination folder) and don't copy the last modified file.
In order to do that, I created a list that sorts all files by last modified date.
I created the following script:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim is_first
is_first = 1
Set list = CreateObject("ADOR.Recordset")
strOriginFolder = "C:\Users\Shelly\Desktop\test"
strDestinationFolder = "C:\Users\Shelly\Desktop\test2"
list.Fields.Append "name", 200, 255
list.Fields.Append "date", 7
list.Open
For Each f In objFSO.GetFolder(strOriginFolder).Files
list.AddNew
list("name").Value = f.Path
list("date").Value = f.DateLastModified
list.Update
Next
list.Sort = "date DESC"
list.MoveFirst
For Each objFile in objFSO.GetFolder(strOriginFolder).Files
If is_first = 0 Then
WScript.Echo list("date").Value & vbTab & list("name").Value
WScript.Echo ("\n")
WScript.Echo list("name").Value
WScript.Echo ("\n")
WScript.Echo objFile.Path
If Not objFSO.FileExists(strDestinationFolder & "\" & list("name").Value) Then
objFSO.CopyFile list("name").Value, strDestinationFolder & "\" &
list("name").Value
End If
End If
is_first = 0
list.MoveNext
Next
list.Close
Now I know that I have a problem with the most importand line:
objFSO.CopyFile list("name").Value, strDestinationFolder & "\" & list("name").Value
But I don't know how to use objFSO.CopyFile with the sorted list. The print from objFile.Path and from WScript.Echo list("name").Value are different of course.
There is not a real need to store the full list of files in memory just to discard the newer one. You can simply iterate over the file list ensuring you don't copy the newer one.
Option Explicit
' Source and target folder configuration
Dim sourceFolderPath, targetFolderPath
sourceFolderPath = ".\source"
targetFolderPath = ".\target"
Dim targetFolder, testFile, newerFile, copyFile
' At the start there is not a new file nor a file to copy
Set newerFile = Nothing
Set copyFile = Nothing
With WScript.CreateObject("Scripting.FileSystemObject")
' Get a full reference to target folder
targetFolder = .GetAbsolutePathName( targetFolderPath )
' Iterate over source file list
For Each testFile In .GetFolder(.GetAbsolutePathName( sourceFolderPath )).Files
' Only process a file if it does not exist on target folder
If Not .FileExists(.BuildPath( targetFolder, testFile.Name )) Then
If newerFile Is Nothing Then
' Is it the first file we see? Remember it as we still don't know
' if it is the newer one
Set newerFile = testFile
ElseIf testFile.DateLastModified > newerFile.DateLastModified Then
' We have found a file newer than the previously seen
' Select the previous one to copy and remember this new file
Set copyFile = newerFile
Set newerFile = testFile
Else
' Current file is not the newer one, copy it
Set copyFile = testFile
End If ' newerFile
' Is there a file to copy?
If Not (copyFile Is Nothing) Then
WScript.Echo "Copying " & copyFile.Path & " to " & .BuildPath( targetFolder, copyFile.Name )
copyFile.Copy .BuildPath( targetFolder, copyFile.Name )
Set copyFile = Nothing
End If ' copyFile
End If ' FileExists
Next ' testFile
End With ' FileSystemObject
I have a folder with 8 Excel files with the following naming convention:
date_All_Groups
date_HRFull_Status_All
date_RME_Groups_Excluded
These files are used for monthly reports, therefore the date will obviously always be different.
I will be using a macro to manipulate the data in each worksheet, however I cannot create the macro due the changing file name (the date) - the only guarantee I have is that each of these files will DEFINITELY contain a partial string match.
I have a script that finds the files in the location and will rename the file, but it only renames 1 file and its not the first file in the folder.
My issue is using the For Each loop effectively.
Here's the code I have:
Dim fso, folder, file
Dim folderName, searchFileName, renameFile1, renameFile2, renameFile3, renameFile4, renameFile5, renameFile6, renameFile7, renameFile8
'Path
folderName = "C:\test\"
'Future FileName
renameFile1 = "All Groups.csv"
renameFile2 = "Groups Excluded.csv"
renameFile3 = "No Exclusions.csv"
renameFile4 = "HR.csv"
renameFile5 = "AD Users.csv"
renameFile6 = "Encryption Status.csv"
renameFile7 = "ePO4 Not Encrypted.csv"
renameFile8 = "ePO5 Not Encrypted.csv"
' Create filesystem object and the folder object
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderName)
' Loop over all files in the folder until the searchFileName is found
For Each file In folder.Files
' See If the file starts with the name we search
If InStr(file.Name, "All_Groups") then
file.Name = renameFile1
End If
If InStr(file.Name, "Groups_Excluded") Then
file.Name = renameFile2
End If
If InStr(file.Name, "No_Exclusions") Then
file.Name = renameFile3
End If
If InStr(file.Name, "HR") Then
file.Name = renameFile4
End If
If InStr(file.Name, "AD_Users") then
file.Name = renameFile5
End If
If InStr(file.Name, "Encryption_Status") then
file.Name = renameFile6
End If
If InStr(file.Name, "ePO4") then
file.Name = renameFile7
End If
If InStr(file.Name, "ePO5") then
file.Name = renameFile8
End If
Exit For
' echo the job is completed
WScript.Echo "Completed!"
Next
The original code I found was exactly as above, but with only one If statement inside the For Each loop and the Exit For was inside the If statement.
Currently when I execute the script, the code renames only one file and its always the HR file first.
If I execute the script again, it then starts with All Groups, then Groups Excluded, and so on.
And the "Echo Completed" does not do anything either.
If you just want to rename your files to "canonical" names you could do something like this, assuming that you just want the date from the beginning of the filename removed and the underscores replaced with spaces:
Set re = New RegExp
re.Pattern = "\d{4}-\d{2}-\d{2}_(.*\.csv)"
For Each f In folder.Files
For Each m In re.Execute(f.Name)
f.Name = Replace(m.Submatches(0), "_", " ")
Next
Next
If the files have the same "date" you only need Find for that, for excample (if the date is a iso date "YYYYMMDD") (Date Returns "today" date)
IsoDate=CStr(Year(Date)) & Right("0" & CStr(Month(Date)),2) & Right("0" & CStr(Day(Date)),2)
And the for each:
For Each file In folder.Files
If InStr(file.Name, IsoDate) = 1 then 'if is in the start of the string
file.Name = Mid(file.Name, Len(IsoDate)+1) 'The same name with out date
End IF
Next
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.
When extracting files from a ZIP file I was using the following.
Sub Unzip(strFile)
' This routine unzips a file. NOTE: The files are extracted to a folder '
' in the same location using the name of the file minus the extension. '
' EX. C:\Test.zip will be extracted to C:\Test '
'strFile (String) = Full path and filename of the file to be unzipped. '
Dim arrFile
arrFile = Split(strFile, ".")
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(arrFile(0) & "\ ")
pathToZipFile= arrFile(0) & ".zip"
extractTo= arrFile(0) & "\ "
set objShell = CreateObject("Shell.Application")
set filesInzip=objShell.NameSpace(pathToZipFile).items
objShell.NameSpace(extractTo).CopyHere(filesInzip)
fso.DeleteFile pathToZipFile, True
Set fso = Nothing
Set objShell = Nothing
End Sub 'Unzip
This was working, but now I get a "The File Exists" Error.
What is the reason for this? Are there any alternatives?
All above solutions are accurate, but they are not definitive.
If you are trying to extract a zipped file into a temporary folder, a folder that displays "Temporary Folder For YOURFILE.zip" will immediately be created (in C:\Documents and Settings\USERNAME\Local Settings\Temp) for EACH FILE contained within your ZIP file, which you are trying to extract.
That's right, if you have 50 files, it will create 50 folders within your temp directory.
But if you have 200 files, it will stop at 99 and crash stating - The File Exists.
..
Apparently, this does not occur on Windows 7 with the contributions I view above. But regardless, we can still have checks. Alright, so this is how you fix it:
'========================
'Sub: UnzipFiles
'Language: vbscript
'Usage: UnzipFiles("C:\dir", "extract.zip")
'Definition: UnzipFiles([Directory where zip is located & where files will be extracted], [zip file name])
'========================
Sub UnzipFiles(folder, file)
Dim sa, filesInzip, zfile, fso, i : i = 1
Set sa = CreateObject("Shell.Application")
Set filesInzip=sa.NameSpace(folder&file).items
For Each zfile In filesInzip
If Not fso.FileExists(folder & zfile) Then
sa.NameSpace(folder).CopyHere(zfile), &H100
i = i + 1
End If
If i = 99 Then
zCleanup(file, i)
i = 1
End If
Next
If i > 1 Then
zCleanup(file, i)
End If
fso.DeleteFile(folder&file)
End Sub
'========================
'Sub: zCleanup
'Language: vbscript
'Usage: zCleanup("filename.zip", 4)
'Definition: zCleanup([Filename of Zip previously extracted], [Number of files within zip container])
'========================
Sub zCleanUp(file, count)
'Clean up
Dim i, fso
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 1 To count
If fso.FolderExists(fso.GetSpecialFolder(2) & "\Temporary Directory " & i & " for " & file) = True Then
text = fso.DeleteFolder(fso.GetSpecialFolder(2) & "\Temporary Directory " & i & " for " & file, True)
Else
Exit For
End If
Next
End Sub
And that's it, copy and paste those two functions into your VBScript hosted program and you should be good to go, on Windows XP & Windows 7.
Thanks!
You can use DotNetZip from VBScript.
To unpack an existing zipfile, overwriting any files that may exist:
WScript.echo("Instantiating a ZipFile object...")
Dim zip
Set zip = CreateObject("Ionic.Zip.ZipFile")
WScript.echo("Initialize (Read)...")
zip.Initialize("C:\Temp\ZipFile-created-from-VBScript.zip")
WScript.echo("setting the password for extraction...")
zip.Password = "This is the Password."
' set the default action for extracting an existing file
' 0 = throw exception
' 1 = overwrite silently
' 2 = don't overwrite (silently)
' 3 = invoke the ExtractProgress event
zip.ExtractExistingFile = 1
WScript.echo("extracting all files...")
Call zip.ExtractAll("extract")
WScript.echo("Disposing...")
zip.Dispose()
WScript.echo("Done.")
To create a new zipfile:
dim filename
filename = "C:\temp\ZipFile-created-from-VBScript.zip"
WScript.echo("Instantiating a ZipFile object...")
dim zip2
set zip2 = CreateObject("Ionic.Zip.ZipFile")
WScript.echo("using AES256 encryption...")
zip2.Encryption = 3
WScript.echo("setting the password...")
zip2.Password = "This is the Password."
WScript.echo("adding a selection of files...")
zip2.AddSelectedFiles("*.js")
zip2.AddSelectedFiles("*.vbs")
WScript.echo("setting the save name...")
zip2.Name = filename
WScript.echo("Saving...")
zip2.Save()
WScript.echo("Disposing...")
zip2.Dispose()
WScript.echo("Done.")
There's answers above which are perfectly correct, but I thought I'd wrap everything up into a full solution that I'm using:
strZipFile = "test.zip" 'name of zip file
outFolder = "." 'destination folder of unzipped files (must exist)
'If using full paths rather than relative to the script, comment the next line
pwd = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
Set objShell = CreateObject( "Shell.Application" )
Set objSource = objShell.NameSpace(pwd+strZipFile).Items()
Set objTarget = objShell.NameSpace(pwd+outFolder)
intOptions = 256
objTarget.CopyHere objSource, intOptions
'Clean up
Set WshShell = CreateObject("Wscript.Shell")
tempfolder = WshShell.ExpandEnvironmentStrings("%temp%")
Set fso = CreateObject("Scripting.FileSystemObject")
Call fso.DeleteFolder(tempfolder + "\Temporary Directory 1 for " + strZipFile, True )
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23022290.html
Check your temp directory. If you have 99 folders associated with this unzipping process, try deleting them.
I added the following code to the beginning of my unzip procedure to delete these directories before I unzip:
For i = 1 To 99
If aqFileSystem.Exists(GetAppPath("Local Settings", "") & "\Temp\Temporary Directory " & i & " for DialogState.zip") = True Then
result = aqFileSystem.ChangeAttributes(GetAppPath("Local Settings", "") & "\Temp\Temporary Directory " & i & " for DialogState.zip", 1 OR 2, aqFileSystem.fattrFree)
Call DelFolder(GetAppPath("Local Settings", "") & "\Temp\Temporary Directory " & i & " for DialogState.zip")
Else
Exit For
End If
Next