I have files with following naming convention.
RE12356_GJ123456789.DAT
I need to rename the file to RE12356_GJ123456790.DAT without copying the files using VBS i.e. I need to increment by 1, everytime when I run VBS file. Please help me. Thanks!
The FileSystemObject has a method .GetFile(FileSpec) that returns an object for the file FileSpec. Those objects have a (writable) .Name property. So get the .Name, modify it, and write/assign the new one.
To give you some ideas (looping over the files in a folder, finding the file(s) to change, extracting the number to increment):
Option Explicit
Dim goFS : Set goFS = CreateObject( "Scripting.FileSystemObject" )
WScript.Quit demoMain()
Function demoMain()
demoMain = 0 ' assume success
Dim sDDir : sDDir = goFS.GetAbsolutePathName(".\")
Dim reVictim : Set reVictim = New RegExp
reVictim.IgnoreCase = True
reVictim.Pattern = "^(victim)(\d+)(\.txt)$"
Dim oFile
For Each oFile In goFS.GetFolder(sDDir).Files
If reVictim.Test(oFile.Name) Then
WScript.Echo "found: ", oFile.Name
oFile.Name = reVictim.Replace(oFile.Name, GetRef("FINC"))
WScript.Echo "renamed:", oFile.Name
End If
Next
End Function ' demoMain
Function FINC(sM, sG1, sG2, sG3, nP, sS)
FINC = sG1 & Right(100 + sG2 + 1, 2) & sG3
End Function
output:
cscript finc.vbs
found: victim00.txt
renamed: victim01.txt
cscript finc.vbs
found: victim01.txt
renamed: victim02.txt
cscript finc.vbs
found: victim02.txt
renamed: victim03.txt
How to copy with overflow of the counter is left as exercise.
You can just use the "move" command which will not actually rewrite the file but will just move the entry in the file table... which is essentially a "rename"
If you don't want to use filesystemobject.move you could issue a command line rename command via: Wsript.shell
like...
Dim objShell
Set objShell = WScript.CreateObject ("WScript.shell")
objShell.run "cmd /c rename somefile.txt newname.txt"
Set objShell = Nothing
or as Ekkehard.Horner pointed out:
Dim fso, f, s
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(filespec)
f.name = "newFileName.txt"
see: Name Property (FileSystemObject)
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 have a quite simple task.
There is a folder which contains several files with different extensions. I need to make a script which will find all files with .txt extension in this folder, read first line from every file and then write all first lines in newly created file.
For now, I've ended up with something like this:
Option Explicit
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim f, colFiles , objFile
Dim tFolder, tFile
Dim lineToCopy, fileContents
Dim input, output
Set tFolder = fso.GetFolder("C:\Temp")
Set tFile = tFolder.CreateTextFile("test.txt", true)
Set f = fso.GetFolder("D:\Folder")
Set colFiles = f.Files
For Each objFile in colFiles
If LCase(fso.GetExtensionName(objFile.name)) = "txt" Then
Set input = fso.OpenTextFile(LCase(objFile.name))
If Not input.AtEndofStream Then lineToCopy = input.ReadLine
input.close
output = fso.OpenTextFile(tFolder, True)
output.WriteLine lineToCopy
output.close
End If
Next
WScript.sleep 60000000
When activated, .vbs file tells me he couldn't find the file from that line:
Set input = fso.OpenTextFile(LCase(objFile.name))
I suppose that happens because IF LCASE<...> block doesn't understand folder contents as .txt files. Where am I wrong and what is needed to be done to solve that problem?
Kindly yours,
Richard
Use the full .Path of the file for OpenTextFile or get the stream via OpenAsTextStream. Use tFile instead of repeatedly creating output. Delete all the risky/cargo cult fat:
Option Explicit
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim tFile : Set tFile = fso.CreateTextFile(fso.BuildPath(".\", "test.txt"))
Dim oFile
For Each oFile in fso.GetFolder("..\data").Files
If LCase(fso.GetExtensionName(oFile.Path)) = "txt" Then
' Dim input: Set input = fso.OpenTextFile(LCase(oFile.Path))
Dim input: Set input = oFile.OpenAsTextStream()
If Not input.AtEndofStream Then tFile.WriteLine input.ReadLine()
input.Close
End If
Next
tFile.Close
Looks like I've found my own decision:
Option Explicit
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim f, colFiles , objFile
Dim tFolder, tFile
Dim lineToCopy, readFile
Set tFolder = fso.GetFolder("C:\Temp")
Set tFile = tFolder.CreateTextFile("test.txt", true)
Set f = fso.GetFolder("D:\Scripting Games 2008\Beginner")
Set colFiles = f.Files
For Each objFile in colFiles
If LCase(fso.GetExtensionName(objFile.name)) = "txt" Then
REM Preceding passage finds all .txt files in selected folder
Set readFile = objFile.OpenAsTextStream
lineToCopy = ""
Do Until lineToCopy <> "" Or readfile.atEndOfStream
lineToCopy = Trim(readFile.ReadLine)
Loop
REM Extracts first line of the text, if it is not empty
tFile.WriteLine objFile.name & ": " & lineToCopy
End If
Next
Still, thanks for the answers. I've found some interesting solutions which well be of use some time.
Kindly yours,
Richard
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
Hello guys I have an issue or issues with my code above
I'm trying to get "sExtension" to be search in a different folder other that the one I'm using to save my script since this script will be use as a Startup Script on many computers
(It works only if I run the script in the same folder "sExtension", "ExtAssign.txt" and sComputername are otherwise it wont find the path)
This is what it should do
Read a file called "ExtAssign.txt" (There is a full list of computer names in that file) and if it find the computer name on that file then it should copy a file with the with the extension number assigned to that computer name from a file server to "C:\" Drive
For this example I'm trying to do this locally, If I can make it then I'll try it from my File Server
Set objFSO = CreateObject("Scripting.FileSystemObject")
set oFso = CreateObject("Scripting.FileSystemObject")
Set objFS = CreateObject("Scripting.FileSystemObject")
Set fso = CreateObject("Scripting.FileSystemObject")
set oShell = WScript.CreateObject("WScript.Shell")
set oShellEnv = oShell.Environment("Process")
Set folder = Fso.GetFolder("C:\Users\XXXXX\Desktop\Test\Extensions\")
Set wshshell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("WScript.Network")
Set ObjEnv = WshShell.Environment("Process")
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
Scomputername = ObjEnv("COMPUTERNAME")
Set objFSO = CreateObject("Scripting.FileSystemObject")
set objWShell = wScript.createObject("WScript.Shell")
Dim strFile
'File to scan
strFile = "C:\Users\XXXXX\Desktop\Test\Extensions\Extassign\ExtAssign.txt"
Dim strPattern
'Look for computer name in file
strPattern = scomputername
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.OpenTextFile(strFile)
Do Until objFile.AtEndOfStream
Dim strLine
'Read each line and store it in strLine
strLine = objFile.ReadLine
'If the line matches the computer name, save the line to ExtArray
If InStr(strLine,strPattern)>0 Then
Dim ExtArray
'Split the line and separate the extension
ExtArray = Split(strLine,"|", -1, 1)
Dim sExtension
'Save the extension to sExtension
sExtension=ExtArray(1)
End If
Loop
'If the sExtension is empty, computer was not found, send message and terminate script.
If sExtension="" Then
WScript.Echo "ERROR: Computer "& scomputername &" not found in Extension Assignment List, so no extension has been set. Avaya will not be launched. Please contact your IT department for assistance."
Else
'If the sExtension contains a number, Copy that file to C:\ and rename it to Config.xml
fso.CopyFile "C:\Users\XXXXX\Desktop\Test\Extensions\ "& sExtension &"", "C:\Config.xml", True
End If
at the end it if it finds the file sExtension it will rename it to Config.xml but it wont do it unless I run the script in the same folder sExtension and sComputername.
I get File not found error
Thank you in advance and Happy new year!
The culprit is most likely this line:
fso.CopyFile "C:\Users\XXXXX\Desktop\Test\Extensions\ "& sExtension &"", "C:\Config.xml", True
There is a trailing space after the last backslash in the path, so you're creating a path
C:\Users\XXXXX\Desktop\Test\Extensions\ 12345
^
when you actually want a path
C:\Users\XXXXX\Desktop\Test\Extensions\12345
On a more general note: why are you creating 7(!) FileSystemObject instances (replacing one of them three times on top of that)? And 3(!) WScript.Shell instances? You don't even use most of them, not to mention that you don't need the Shell object in the first place. You only use it for determining the computer name, which could be done just fine using the WScript.Network object (that you don't use at all).
Also, please don't ever use comments like this:
'Read each line and store it in strLine
strLine = objFile.ReadLine
It's quite obvious that you read each line and assign it to the variable strLine. Comments shouldn't rephrase what you're doing (the code already does that, at least when you're using speaking variable and function names), but why you're doing it, i.e. what the purpose of a particular code section is.
Your code could be reduced to something as simple as this:
Set fso = CreateObject("Scripting.FileSystemObject")
Set net = CreateObject("WScript.Network")
computername = net.ComputerName
foldername = "C:\Users\XXXXX\Desktop\Test\Extensions"
filename = fso.BuildPath(foldername, "Extassign\ExtAssign.txt")
Set f = fso.OpenTextFile(filename)
Do Until f.AtEndOfStream
line = f.ReadLine
If InStr(line, computername) > 0 Then
arr = Split(line, "|", -1, 1)
If UBound(arr) >= 1 Then extension = arr(1)
End If
Loop
f.Close
If IsEmpty(extension) Then
WScript.Echo "ERROR: Computer "& computername &" not found in ..."
Else
fso.CopyFile fso.BuildPath(foldername, extension), "C:\Config.xml", True
End If
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