I am very new to VB Script. I am in need of VB Script to replace the specific text
Below is my file directory
E:\TEST\98\6549871\1959893\HTML
E:\TEST\98\6549871\1959793\HTML
E:\TEST\98\6549876\1959863\HTML
E:\TEST\96\6749473\6959895\HTML
E:\TEST\99\2548878\5959893\HTML
etc.,
Where in each HTML sub-folder, test.html and img.html page will contain. In that html pages I want to find the text ="img/ and needs to replace with ="/image/98/6549871/1959893/HTML/img/ where in ="/image/ is common for all files and remaining values are as per folder structure (i.e. 1st level folder name, 2nd level folder name, 3rd level folder name and 4th level folder name)
For every individual file I need to do like above, and taking too much time to do this activity.
Can any body help me on this to replace all ="img/ in a single shot base on the folder directory.
Thanks in advance
Something like this..not tested, but shoudl point you in the right direction
Option Explicit
Dim fileCount
Sub ProcessSubDirectory( ByVal directory)
On Error Resume Next
Dim fso
Dim dir
Dim folder
Dim file
Set fso = CreateObject("Scripting.FileSystemObject")
Set dir = fso.GetFolder(directory)
If Err.Number <> 0 THen
MsgBox "Failed to open dir ( " & directory & " )"
Exit Sub
End If
On Error Goto 0
For Each file in dir.Files
Call HandleFileFix( file.Path )
Next
For Each folder in dir.SubFolders
Call ProcessSubDirectory( folder.Path )
Next
Set fso = Nothing
End Sub
Sub HandleFileFix( ByVal file)
Dim fso
Dim f
Dim fo
Dim contents
DIm path
Set fso = CreateObject("Scripting.FileSystemObject")
Set fo = fso.GetFile( file )
Set f = fso.OpenTextFile( file, 1 )
path = fo.Path
path = Replace( path, fo.Drive, "")
path = Replace( path, fo.Name, "")
path = Replace( path, "\", "/")
If f.AtEndOfStream = false then
contents = f.ReadAll
End If
f.Close
Set f = Nothing
contents = Replace( contents, "='img/", "='" & path & "/img/")
' write file back to disk
Set f = fso.OpenTextFile( file, 2 )
f.Write contents
f.Close
fileCount = fileCount + 1
Set f = Nothing
End Sub
fileCount = 0
Call ProcessSubDirectory( "D:\TEST\" )
MsgBox "done (" & CStr(fileCount) & ")"
Related
I am trying to rename a file and was using the below code but it does not seem to work. Can someone please tell me why? What is the correct way to rename a file from VBScript?
FSO.GetFile("MyFile.txt).Name = "Hello.txt"
I am using this thread for reference: Rename files without copying in same folder
You can rename the file using FSO by moving it: MoveFile Method.
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Fso.MoveFile "A.txt", "B.txt"
I see only one reason your code to not work, missed quote after file name string:
VBScript:
FSO.GetFile("MyFile.txt[missed_quote_here]).Name = "Hello.txt"
Yes you can do that.
Here I am renaming a .exe file to .txt file
rename a file
Dim objFso
Set objFso= CreateObject("Scripting.FileSystemObject")
objFso.MoveFile "D:\testvbs\autorun.exe", "D:\testvbs\autorun.txt"
Rename filename by searching the last character of name. For example,
Original Filename: TestFile.txt_001
Begin Character need to be removed: _
Result: TestFile.txt
Option Explicit
Dim oWSH
Dim vbsInterpreter
Dim arg1 'As String
Dim arg2 'As String
Dim newFilename 'As string
Set oWSH = CreateObject("WScript.Shell")
vbsInterpreter = "cscript.exe"
ForceConsole()
arg1 = WScript.Arguments(0)
arg2 = WScript.Arguments(1)
WScript.StdOut.WriteLine "This is a test script."
Dim result
result = InstrRev(arg1, arg2, -1)
If result > 0 then
newFilename = Mid(arg1, 1, result - 1)
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Fso.MoveFile arg1, newFilename
WScript.StdOut.WriteLine newFilename
End If
Function ForceConsole()
If InStr(LCase(WScript.FullName), vbsInterpreter) = 0 Then
oWSH.Run vbsInterpreter & " //NoLogo " & Chr(34) & WScript.ScriptFullName & Chr(34)
WScript.Quit
End If
End Function
From what I understand, your context is to download from ALM.
In this case, ALM saves the files under:
C:/Users/user/AppData/Local/Temp/TD_80/ALM_VERSION/random_string/Attach/artefact_type/ID
where :
ALM_VERSION is the version of your alm installation, e.g 12.53.2.0_952
artefact_type is the type of the artefact, e.g : REQ
ID is the ID of the artefact
Herebelow a code sample which connects to an instance of ALM, domain 'DEFAUT', project 'MY_PROJECT', gets all the attachments from a REQ with id 6 and saves them in c:/tmp. It's ruby code, but it's easy to transcribe to VBSctript
require 'win32ole'
require 'fileutils'
# login to ALM and domain/project
alm_server = ENV['CURRRENT_ALM_SERVER']
tdc = WIN32OLE.new('TDApiOle80.TDConnection')
tdc.InitConnectionEx(alm_server)
username, password = ENV['ALM_CREDENTIALS'].split(':')
tdc.Login(username, password)
tdc.Connect('DEFAULT', 'MY_PROJECT')
# get a handle for the Requirements
reqFact = tdc.ReqFactory
# get Requirement with ID=6
req = reqFact.item(6)
# get a handle for the attachment of REQ
att = req.Attachments
# get a handle for the list of attachements
attList = att.NewList("")
thePath= 'c:/tmp'
# for each attachment:
attList.each do |el|
clientPath = nil
# download the attachment to its default location
el.Load true, clientPath
baseName = File.basename(el.FileName)
dirName = File.dirname(el.FileName)
puts "file downloaded as : #{baseName}\n in Folder #{dirName}"
FileUtils.mkdir_p thePath
puts "now moving #{baseName} to #{thePath}"
FileUtils.mv el.FileName, thePath
end
The output:
=> file downloaded as : REQ_6_20191112_143346.png
=> in Folder C:\Users\user\AppData\Local\Temp\TD_80\12.53.2.0_952\e68ab622\Attach\REQ\6
=> now moving REQ_6_20191112_143346.png to c:/tmp
Below code absolutely worked for me to update File extension.
Ex: abc.pdf to abc.txt
Filepath = "Pls mention your Filepath"
Set objFso = CreateObject("Scripting.FileSystemObject")
'' Below line of code is to get the object for Folder where list of files are located
Set objFolder = objFso.GetFolder(Filepath)
'' Below line of code used to get the collection object to hold list of files located in the Filepath.
Set FileCollection = objFolder.Files
For Each file In FileCollection
WScript.Echo "File name ->" + file.Name
''Instr used to Return the position of the first occurrence of "." within the File name
s = InStr(1, file.Name, ".",1)
WScript.Echo s
WScript.Echo "Extn --> " + Mid(file.Name, s, Len(file.Name))
'Left(file.Name,s-1) = Used to fetch the file name without extension
' Move method is used to move the file in the Desitnation folder you mentioned
file.Move(Filepath & Left(file.Name,s-1)&".txt")
Next
Rename File using VB SCript.
Create Folder Source and Archive in D : Drive. [You can choose other drive but make change in code from D:\Source to C:\Source in case you create folder in C: Drive]
Save files in Source folder to be renamed.
Save below code and save it as .vbs e.g ChangeFileName.vbs
Run file and the file will be renamed with existing file name and current date
Option Explicit
Dim fso,sfolder,fs,f1,CFileName,strRename,NewFilename,GFileName,CFolderName,CFolderName1,Dfolder,afolder
Dim myDate
myDate =Date
Function pd(n, totalDigits)
if totalDigits > len(n) then
pd = String(totalDigits-len(n),"0") & n
else
pd = n
end if
End Function
myDate=
Pd(DAY(date()),2) & _
Pd(Month(date()),2) & _
YEAR(Date())
'MsgBox ("Create Folders 'Source' 'Destination ' and 'Archive' in D drive. Save PDF files into Source Folder ")
sfolder="D:\Source\"
'Dfolder="D:\Destination\"
afolder="D:\archive\"
Set fso= CreateObject("Scripting.FileSystemObject")
Set fs= fso.GetFolder(sfolder)
For each f1 in fs.files
CFileName=sfolder & f1.name
CFolderName1=f1.name
CFolderName=Replace(CFolderName1,"." & fso.GetExtensionName(f1.Path),"")
'Msgbox CFileName
'MsgBox CFolderName
'MsgBox myDate
GFileName=fso.GetFileName(sfolder)
'strRename="DA009B_"& CFolderName &"_20032019"
strRename= "DA009B_"& CFolderName &"_"& myDate &""
NewFilename=replace(CFileName,CFolderName,strRename)
'fso.CopyFile CFolderName1 , afolder
fso.MoveFile CFileName , NewFilename
'fso.CopyFile CFolderName, Dfolder
Next
MsgBox "File Renamed Successfully !!! "
Set fso= Nothing
Set fs=Nothing
I am using this code to zip all files in a folder into a newly created .zip file:
Dim FileNameZip, FolderName
Dim filename As String, DefPath As String
Dim oApp As Object
(defining all paths needed)
'Create empty Zip File
NewZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
'Copy the files to the compressed folder
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = oApp.Namespace(FolderName).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
This works without problems as long as my target folder is different from the folder where my files are.
But I have a problem when I try to take all files from a folder, put them into .zip and have the archive generated in the same folder - it creates the archive and then tries to put it into itself, which of course fails.
I am looking for a way to zip all files from a folder except this one newly created.
I looked here: https://msdn.microsoft.com/en-us/library/office/ff869597.aspx but this looks very Outlook-specific and I have no idea how to apply this to a Windows folder.
Rather than add all files at once, which will include the zip file you create, loop through the files with the FileSystemObject and compare their names against the zip file name before adding to the zip:
Sub AddFilesToZip()
Dim fso As Object, zipFile As Object, objShell As Object
Dim fsoFolder As Object, fsoFile As Object
Dim timerStart As Single
Dim folderPath As String, zipName As String
folderPath = "C:\Users\darre\Desktop\New folder\" ' folder to zip
zipName = "myzipfile.zip" ' name of the zip file
Set fso = CreateObject("Scripting.FileSystemObject") ' create an fso to loop through the files
Set zipFile = fso.CreateTextFile(folderPath & zipName) ' create the zip file
zipFile.WriteLine Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
zipFile.Close
Set objShell = CreateObject("Shell.Application")
Set fsoFolder = fso.GetFolder(folderPath)
For Each fsoFile In fsoFolder.Files ' loop through the files...
Debug.Print fsoFile.name
If fsoFile.name <> zipName Then ' and check it's not the zip file before adding them
objShell.Namespace("" & folderPath & zipName).CopyHere fsoFile.Path
timerStart = Timer
Do While Timer < timerStart + 2
Application.StatusBar = "Zipping, please wait..."
DoEvents
Loop
End If
Next
' clean up
Application.StatusBar = ""
Set fsoFile = Nothing
Set fsoFolder = Nothing
Set objShell = Nothing
Set zipFile = Nothing
Set fso = Nothing
MsgBox "Zipped", vbInformation
End Sub
I would create the zip file in the temporary folder and finally move it to the destination folder. Two notes worth mentioning:
1- The approach of looping until the Item counts are the same in the folder and the zip file is risky, because if the zipping fails for an individual item, it results in an infinite loop. For this reason it's preferable to loop as long as the zip file is locked by the shell.
2- I will use early binding with the Shell because late-binding the Shell32.Application seems to have issues on some installations. Add a reference to Microsoft Shell Controls and Automation
Sub compressFolder(folderToCompress As String, targetZip As String)
If Len(Dir(targetZip)) > 0 Then Kill targetZip
' Create a temporary zip file in the temp folder
Dim tempZip As String: tempZip = Environ$("temp") & "\" & "tempzip1234.zip"
CreateObject("Scripting.FileSystemObject").CreateTextFile(tempZip, True).Write _
Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
' compress the folder into the temporary zip file
With New Shell ' For late binding: With CreateObject("Shell32.Application")
.Namespace(tempZip).CopyHere .Namespace(folderToCompress).Items
End With
' Move the temp zip to target. Loop until the move succeeds. It won't
' succeed until the zip completes because zip file is locked by the shell
On Error Resume Next
Do Until Len(Dir(targetZip)) > 0
Application.Wait Now + TimeSerial(0, 0, 1)
Name tempZip As targetZip
Loop
End Sub
Sub someTest()
compressFolder "C:\SO\SOZip", "C:\SO\SOZip\Test.zip"
End Sub
I found zipping via VBA to be hard to control without third party tools, the below may not be a direct answer but may aid as a solution. The below is an excerpt of the code I used to generate epubs which are not much more than zip files with a different extension. This zipping section never failed in hundreds of runs.
Public Function Zip_Create(ByVal StrFilePath As String) As Boolean
Dim FSO As New FileSystemObject
Dim LngCounter As Long
If Not FSO.FileExists(StrFilePath) Then
'This makes the zip file, note the FilePath also caused issues
'it should be a local file, suggest root of a drive and then use FSO
'to open it
LngCounter = FreeFile
Open StrFilePath For Output As #LngCounter
Print #LngCounter, "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
Close #LngCounter
End If
Zip_Create = True
End Function
Public Function Zip_Insert(ByVal StrZipFilePath As String, ByVal StrObject As String) As Boolean
Dim BlnYesNo As Boolean
Dim LngCounter As Long
Dim LngCounter2 As Long
Dim ObjApp As Object
Dim ObjFldrItm As Object
Dim ObjFldrItms As Object
Dim StrContainer As String
Dim StrContainer2 As String
If Procs.Global_IsAPC Then
'Create the zip if needed
If Not FSA.File_Exists(StrZipFilePath) Then
If Not Zip_Create(StrZipFilePath) Then
Exit Function
End If
End If
'Connect to the OS Shell
Set ObjApp = CreateObject("Shell.Application")
'Pause, if it has just been created the next piece of
'code may not see it yet
LngCounter2 = Round(Timer) + 1
Do Until CLng(Timer) > LngCounter2
DoEvents
Loop
'Divide the path and file
StrContainer = Right(StrObject, Len(StrObject) - InStrRev(StrObject, "\"))
StrObject = Left(StrObject, Len(StrObject) - Len(StrContainer))
'Connect to the file (via the path)
Set ObjFldrItm = ObjApp.NameSpace(CVar(StrObject)).Items.Item(CVar(StrContainer))
'Pauses needed to avoid all crashes
LngCounter2 = CLng(Timer) + 1
Do Until CLng(Timer) > LngCounter2
DoEvents
Loop
'If it is a folder then check there are items to copy (so as to not cause and error message
BlnYesNo = True
If ObjFldrItm.IsFolder Then
If ObjFldrItm.GetFolder.Items.Count = 0 Then BlnYesNo = False
End If
If BlnYesNo Then
'Take note of how many items are in the Zip file
'Place item into the Zip file
ObjApp.NameSpace(CVar(StrZipFilePath)).CopyHere ObjFldrItm
'Pause to stop crashes
LngCounter2 = CLng(Timer) + 1
Do Until CLng(Timer) > LngCounter2
DoEvents
Loop
'Be Happy
Zip_Insert = True
End If
Set ObjFldrItm = Nothing
Set ObjApp = Nothing
End If
End Function
I need to recursively search for multiple files through the C:\Users directory tree recursively.
If I find any of the specified files in any of the sub-directories, I want to echo out the full path.
Here is what I have:
Dim fso,folder,files,sFolder,newFolder
Dim arr1
arr1 = Array("myFile1.pdf","myFile2.pdf","myFile3.pdf","nutbag.rtf","whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "C:\Users"
Set folder = fso.GetFolder(sFolder)
Set files = folder.SubFolders
For each folderIdx In files
IF (Instr(folderIdx.Name,"Default") <> 1) Then
If (Instr(folderIdx.Name,"All Users") <> 1) Then
newFolder = sfolder & "\" & folderIdx.Name
CopyUpdater fso.GetFolder(newFolder)
End If
End If
Next
Sub CopyUpdater(fldr)
For Each f In fldr.Files
For Each i in arr1
If LCase(f.Name) = i Then
WScript.echo(f.name)
End If
Next
Next
For Each sf In fldr.SubFolders
CopyUpdater sf
Next
End Sub
If I run it as 'Administrator', I get:
VBScript runtime error: Permission Denied
If I run it as 'Local System' user, I get:
VBScript runtime error: Path not found
If I add, 'On Error Resume Next' to the beginning to suppress the errors, I get nothing back.
I have placed a text file called 'whoa.txt' in numerous locations around the C:\Users sub-dirs.
My suspicion is that it is a Windows permissions thing, but I am unsure.
Thanks much.
First I didn't use your code, it confuses me what you are trying to accomplish.
Next you should run the script in Administrator mode command prompt. This should allow you to check if the file is there.
Then paste code below to a vbs file and cscript it. This code displays all the matched filenames.My idea is that instead of going through all files in any folder for a matching filename, check if those wanted files exists in that folder - this is generally faster as some folders contains hundreds of files if not thousands (check your Temp folder!).
Option Explicit
Const sRootFolder = "C:\Users"
Dim fso
Dim arr1
Dim oDict ' Key: Full filename, Item: Filename
Main
Sub Main
arr1 = Array("myFile1.pdf", "myFile2.pdf", "myFile3.pdf", "nutbag.rtf", "whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oDict = CreateObject("Scripting.Dictionary")
' Call Recursive Sub
FindWantedFiles(sRootFolder)
' Display All Findings from Dictionary object
DisplayFindings
Set fso = Nothing
Set oDict = Nothing
End Sub
Sub FindWantedFiles(sFolder)
On Error Resume Next
Dim oFDR, oItem
' Check if wanted files are in this folder
For Each oItem In arr1
If fso.FileExists(sFolder & "\" & oItem) Then
oDict.Add sFolder & "\" & oItem, oItem
End If
Next
' Recurse into it's sub folders
For Each oFDR In fso.GetFolder(sFolder).SubFolders
FindWantedFiles oFDR.Path
Next
End Sub
Sub DisplayFindings()
Dim oKeys, oKey
oKeys = oDict.Keys
For Each oKey In oKeys
wscript.echo oKey
Next
End Sub
I am trying to rename a file and was using the below code but it does not seem to work. Can someone please tell me why? What is the correct way to rename a file from VBScript?
FSO.GetFile("MyFile.txt).Name = "Hello.txt"
I am using this thread for reference: Rename files without copying in same folder
You can rename the file using FSO by moving it: MoveFile Method.
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Fso.MoveFile "A.txt", "B.txt"
I see only one reason your code to not work, missed quote after file name string:
VBScript:
FSO.GetFile("MyFile.txt[missed_quote_here]).Name = "Hello.txt"
Yes you can do that.
Here I am renaming a .exe file to .txt file
rename a file
Dim objFso
Set objFso= CreateObject("Scripting.FileSystemObject")
objFso.MoveFile "D:\testvbs\autorun.exe", "D:\testvbs\autorun.txt"
Rename filename by searching the last character of name. For example,
Original Filename: TestFile.txt_001
Begin Character need to be removed: _
Result: TestFile.txt
Option Explicit
Dim oWSH
Dim vbsInterpreter
Dim arg1 'As String
Dim arg2 'As String
Dim newFilename 'As string
Set oWSH = CreateObject("WScript.Shell")
vbsInterpreter = "cscript.exe"
ForceConsole()
arg1 = WScript.Arguments(0)
arg2 = WScript.Arguments(1)
WScript.StdOut.WriteLine "This is a test script."
Dim result
result = InstrRev(arg1, arg2, -1)
If result > 0 then
newFilename = Mid(arg1, 1, result - 1)
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Fso.MoveFile arg1, newFilename
WScript.StdOut.WriteLine newFilename
End If
Function ForceConsole()
If InStr(LCase(WScript.FullName), vbsInterpreter) = 0 Then
oWSH.Run vbsInterpreter & " //NoLogo " & Chr(34) & WScript.ScriptFullName & Chr(34)
WScript.Quit
End If
End Function
From what I understand, your context is to download from ALM.
In this case, ALM saves the files under:
C:/Users/user/AppData/Local/Temp/TD_80/ALM_VERSION/random_string/Attach/artefact_type/ID
where :
ALM_VERSION is the version of your alm installation, e.g 12.53.2.0_952
artefact_type is the type of the artefact, e.g : REQ
ID is the ID of the artefact
Herebelow a code sample which connects to an instance of ALM, domain 'DEFAUT', project 'MY_PROJECT', gets all the attachments from a REQ with id 6 and saves them in c:/tmp. It's ruby code, but it's easy to transcribe to VBSctript
require 'win32ole'
require 'fileutils'
# login to ALM and domain/project
alm_server = ENV['CURRRENT_ALM_SERVER']
tdc = WIN32OLE.new('TDApiOle80.TDConnection')
tdc.InitConnectionEx(alm_server)
username, password = ENV['ALM_CREDENTIALS'].split(':')
tdc.Login(username, password)
tdc.Connect('DEFAULT', 'MY_PROJECT')
# get a handle for the Requirements
reqFact = tdc.ReqFactory
# get Requirement with ID=6
req = reqFact.item(6)
# get a handle for the attachment of REQ
att = req.Attachments
# get a handle for the list of attachements
attList = att.NewList("")
thePath= 'c:/tmp'
# for each attachment:
attList.each do |el|
clientPath = nil
# download the attachment to its default location
el.Load true, clientPath
baseName = File.basename(el.FileName)
dirName = File.dirname(el.FileName)
puts "file downloaded as : #{baseName}\n in Folder #{dirName}"
FileUtils.mkdir_p thePath
puts "now moving #{baseName} to #{thePath}"
FileUtils.mv el.FileName, thePath
end
The output:
=> file downloaded as : REQ_6_20191112_143346.png
=> in Folder C:\Users\user\AppData\Local\Temp\TD_80\12.53.2.0_952\e68ab622\Attach\REQ\6
=> now moving REQ_6_20191112_143346.png to c:/tmp
Below code absolutely worked for me to update File extension.
Ex: abc.pdf to abc.txt
Filepath = "Pls mention your Filepath"
Set objFso = CreateObject("Scripting.FileSystemObject")
'' Below line of code is to get the object for Folder where list of files are located
Set objFolder = objFso.GetFolder(Filepath)
'' Below line of code used to get the collection object to hold list of files located in the Filepath.
Set FileCollection = objFolder.Files
For Each file In FileCollection
WScript.Echo "File name ->" + file.Name
''Instr used to Return the position of the first occurrence of "." within the File name
s = InStr(1, file.Name, ".",1)
WScript.Echo s
WScript.Echo "Extn --> " + Mid(file.Name, s, Len(file.Name))
'Left(file.Name,s-1) = Used to fetch the file name without extension
' Move method is used to move the file in the Desitnation folder you mentioned
file.Move(Filepath & Left(file.Name,s-1)&".txt")
Next
Rename File using VB SCript.
Create Folder Source and Archive in D : Drive. [You can choose other drive but make change in code from D:\Source to C:\Source in case you create folder in C: Drive]
Save files in Source folder to be renamed.
Save below code and save it as .vbs e.g ChangeFileName.vbs
Run file and the file will be renamed with existing file name and current date
Option Explicit
Dim fso,sfolder,fs,f1,CFileName,strRename,NewFilename,GFileName,CFolderName,CFolderName1,Dfolder,afolder
Dim myDate
myDate =Date
Function pd(n, totalDigits)
if totalDigits > len(n) then
pd = String(totalDigits-len(n),"0") & n
else
pd = n
end if
End Function
myDate=
Pd(DAY(date()),2) & _
Pd(Month(date()),2) & _
YEAR(Date())
'MsgBox ("Create Folders 'Source' 'Destination ' and 'Archive' in D drive. Save PDF files into Source Folder ")
sfolder="D:\Source\"
'Dfolder="D:\Destination\"
afolder="D:\archive\"
Set fso= CreateObject("Scripting.FileSystemObject")
Set fs= fso.GetFolder(sfolder)
For each f1 in fs.files
CFileName=sfolder & f1.name
CFolderName1=f1.name
CFolderName=Replace(CFolderName1,"." & fso.GetExtensionName(f1.Path),"")
'Msgbox CFileName
'MsgBox CFolderName
'MsgBox myDate
GFileName=fso.GetFileName(sfolder)
'strRename="DA009B_"& CFolderName &"_20032019"
strRename= "DA009B_"& CFolderName &"_"& myDate &""
NewFilename=replace(CFileName,CFolderName,strRename)
'fso.CopyFile CFolderName1 , afolder
fso.MoveFile CFileName , NewFilename
'fso.CopyFile CFolderName, Dfolder
Next
MsgBox "File Renamed Successfully !!! "
Set fso= Nothing
Set fs=Nothing
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