I have hundreds of filenames with a - (dash) 0 (zero) like V-45X-0892-0.pdf, V-45X-0893-0.pdf and would like to strip the -0 from filename.
Here's what I have but is not working.
folderspec = "C:\Dave\"
strRename = ""
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
For Each f1 In f.Files
Filename = folderspec & f1.Name
NewFilename = Replace(Filename, "%-0.pdf""%.pdf", strRename)
fs.MoveFile Filename, NewFilename
Next
MsgBox "All Done"
Here's code based on your Question with modifications made to the For Each loop. Note that you don't need to use MoveFile, you can simply update the file's Name property directly:
Dim objFSO
Dim objFolder
Dim objFile
Dim sFolderSpec
sFolderSpec = "C:\Dave\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(sFolderSpec)
For Each objFile In objFolder.Files
If InStr(objFile.Name, "-0") > 0 Then objFile.Name = Replace(objFile.Name, "-0", "")
Next
MsgBox "All Done"
Related
I am trying to get this script to copy all files starting with "XX". Currently it only copies one file.
Dim objFSO, colFiles, objFile, strDestFolder, objNewestFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = objFSO.GetFolder("C:\source")
strDestFolder = "C:\destination\"
For Each objFile In colFiles.Files
If Left(objFile.Name, 2) = "XX" Then
If objNewestFile = "" Then
Set objNewestFile = objFile
Else
If objNewestFile.DateLastModified < objFile.DateLastModified Then
Set objNewestFile = objFile
End If
End If
End If
Next
If Not objNewestFile Is Nothing Then
objFSO.CopyFile objNewestFile.Path,strDestFolder,True
End If
WScript.Echo "Copied."
You can use wildcards * and ? in [source] argument of FSO .CopyFile method.
So the code may look like:
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile "C:\source\XX*.*", "C:\destination\", True
WScript.Echo "Copied."
I want to write a VBScript that can access a config file which has the folder path. Once directed to the folder, there are documents with _DDMMYYYY. I want to remove the _ and the date stamp.
Can somebody help me please?
Option Explicit
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
'Declare the variables to be used from the property file
Dim Folder
Dim objWMIService, objProcess, colProcess, obNetwork
Dim strComputer, WshShell, strComputerName
strComputer = "."
Set obNetwork = WScript.CreateObject("Wscript.Network")
strComputerName = obNetwork.ComputerName
Set obNetwork = Nothing
SetConfigFromFile("C:\Users\Lenovo\Desktop\RenameFile\ConfigPad.txt")
MsgBox "Folder = " & Folder
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run Folder
'---------- Get Variables from ConfigPad.txt ----------
Sub SetConfigFromFile(fileName)
Dim strConfigLine
Dim fConFile
Dim EqualSignPosition
Dim strLen
Dim VariableName
Dim VariableValue
Set fConFile = fso.OpenTextFile(fileName)
While Not fConFile.AtEndOfStream
strConfigLine = fConFile.ReadLine
strConfigLine = Trim(strConfigLine)
'MsgBox(strConfigLine)
If (InStr(1,strConfigLine,"#",1) <> 1 And Len(strConfigLine) <> 0) Then
EqualSignPosition = InStr(1, strConfigLine, "=", 1)
strLen = Len(strConfigLine)
VariableName = LCase(Trim(MID(strConfigLine, 1, EqualSignPosition-1))) 'line 34
VariableValue = Trim(Mid(strConfigLine, EqualSignPosition + 1, strLen - EqualSignPosition))
Select Case VariableName
'ADD EACH OCCURRENCE OF THE CONFIGURATION FILE VARIABLES(KEYS)
Case LCase("Folder")
If VariableValue <> "" Then Folder = VariableValue
End Select
End If
Wend
fConFile.Close
End Sub
'---------- Rename the documents ----------
Dim FLD
Dim fil
Dim strOldName
Dim strNewName
Dim strFileParts
'Set the folder you want to search.
Set FLD = FSO.GetFolder("C:\Users\Lenovo\Desktop\RenameFile\RenameFile.vbs")
'Loop through each file in the folder
For Each fil in FLD.Files
'Get complete file name with path
strOldName = fil.Path
'Check the file has an underscore in the name
If InStr(strOldName, "_") > 0 Then
'Split the file on the underscore so we can get everything before it
strFileParts = Split(strOldName, "_")
'Build the new file name with everything before the
'first under score plus the extension
strNewName = strFileParts(0) & ".txt"
'Use the MoveFile method to rename the file
FSO.MoveFile strOldName, strNewName
End If
Next
'Cleanup the objects
Set FLD = Nothing
Set FSO = Nothing
My config file only has this:
Folder = "C:\Users\Lenovo\Desktop\RenameFile\Test - Copy"
Set fso = CreateObject("Scripting.FileSystemObject")
Set TS = fso.OpenTextFile("C:\Users\Lenovo\Desktop\RenameFile\ConfigPad.txt")
SrcFolder = TS.ReadLine
Set fldr = fso.GetFolder(SrcFolder)
Set Fls = fldr.files
For Each thing in Fls
If Left(thing.name, 1) = "_" AND IsNumeric(Mid(thing.name, 2, 8)) Then
thing.name = mid(thing.name, 10)
End If
Next
This assumes the first line in the config file is a path. It renames any files starting with an underscore and followed by 8 digits.
Please Try This
configfile = "Config File Name Here" 'Example : C:\Documents\Config.txt
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set tf = objFSO.OpenTextFile(configfile, 1)
Do Until tf.AtEndOfStream
cl = tf.ReadLine
If InStr(cl, "Folder = ") > 0 Then
Folder = Replace(Replace(cl,"Folder = ",""),chr(34),"")
tf.Close
Exit Do
End If
Loop
For Each File in objFSO.GetFolder(Folder).Files
If InStr(File.Name, "_") > 0 And IsNumeric(Mid(File.Name,InStr(File.Name, "_") + 1,8)) Then
NewName = Replace(File.Name,Mid(File.Name,InStr(File.Name, "_"),9),"")
objFSO.MoveFile File.Path, objFSO.GetParentFolderName(File.Path) & "\" & NewName
End If
Next
MsgBox "Task Complete", vbOKOnly, "Remove Time Stamp"
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 have written a VBScript to write all the file names in a folder to a text file, but what I actually want is a listing of only the names of .txt files in a specific folder that have been modified or created today.
The code:
Dim fso
Dim ObjFolder
Dim ObjOutFile
Dim ObjFiles
Dim ObjFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set ObjFolder = fso.GetFolder("D:\test")
Set ObjOutFile = fso.CreateTextFile("D:\test\File_names.txt")
Set ObjFiles = ObjFolder.Files
For Each ObjFile In ObjFiles
ObjOutFile.WriteLine(ObjFile.Name)
Next
ObjOutFile.Close
Its a long time since I have written any VBScript but this is along the right lines. You may need to adjust it a bit
Dim fso
Dim ObjFolder
Dim ObjOutFile
Dim ObjFiles
Dim ObjFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set ObjFolder = fso.GetFolder("c:\temp\")
Set ObjOutFile = fso.CreateTextFile("c:\temp\File_names.txt")
Set ObjFiles = ObjFolder.Files
For Each ObjFile In ObjFiles
If (LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = ".txt") Then
If FormatDateTime(ObjFile.DateLastModified, 2) = FormatDateTime(Now(), 2) OR FormatDateTime(ObjFile.DateCreated , 2) = FormatDateTime(Now(), 2) Then
ObjOutFile.WriteLine(ObjFile.Name)
Else
ObjOutFile.WriteLine(ObjFile.Name & " - Modified:" & FormatDateTime(ObjFile.DateLastModified, 2) & " " & FormatDateTime(Now(),2) & " Created: " & FormatDateTime(ObjFile.DateCreated , 2) & " " & FormatDateTime(Now(), 2) )
End if
Else
ObjOutFile.WriteLine(ObjFile.Name & " Not Text")
End if
Next
ObjOutFile.Close
A code snippet with changes only:
For Each ObjFile In ObjFiles
If StrComp( Right( ObjFile.name, 4), ".txt", vbTextCompare) = 0 and _
( Fix( ObjFile.DateCreated) = Fix( Now) or _
Fix( ObjFile.DateLastModified) = Fix( Now) ) Then
ObjOutFile.WriteLine(ObjFile.Name)
End If
Next
FIX() explanation:
date format is a floating point value, counting days since midnight 30
December 1899. Hours and minutes are represented as fractional days
This script basically goes to a folder and list all the files in that folder and output it in a txt file. Now instead of defining the folder path I want it to use the txt file that contains a bunch of folder paths in it and I want to loop that txt file. How can I do this?
Dim fso
Dim ObjFolder
Dim ObjOutFile
Dim ObjFiles
Dim ObjFile
'Creating File System Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Getting the Folder Object
Set ObjFolder = fso.GetFolder("C:\Users\Susan\Desktop\Anime\ova")
'Creating an Output File to write the File Names
Set ObjOutFile = fso.CreateTextFile("C:\Users\Susan\Documents\iMacros\Macros\WindowsFiles.txt")
'Getting the list of Files
Set ObjFiles = ObjFolder.Files
'Writing Name and Path of each File to Output File
For Each ObjFile In ObjFiles
ObjOutFile.WriteLine(ObjFile.Path)
Next
ObjOutFile.Close
Ruriko, this should be a working version, i would add a check to see if the inputfile exist, i'm sure you can do that yourself.
Dim fso, ObjFolder, ObjOutFile, ObjFiles, ObjFile, outputFile, inputFileList
Const ForReading = 1, ForWriting = 2, ForAppending = 8, CreateIfNeeded = true
inputFileList = "list.txt"
outputFile = "C:\Users\Susan\Documents\iMacros\Macros\WindowsFiles.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set objTextFile = fso.OpenTextFile(inputFileList, ForReading)
Do Until objTextFile.AtEndOfStream
sFolderName = objTextFile.Readline
wscript.Echo "writing contents of " & sFolderName
writefilenames(sFolderName)
Loop
function writefilenames(sFolderName)
Set ObjFolder = fso.GetFolder(sFolderName)
If fso.FileExists(outputFile) Then
Set ObjOutFile = fso.OpenTextFile(outputFile, ForAppending)
Else
Set ObjOutFile = fso.OpenTextFile(outputFile, ForWriting, CreateIfNeeded)
End If
Set ObjFiles = ObjFolder.Files
For Each ObjFile In ObjFiles
ObjOutFile.WriteLine(ObjFile.Path)
Next
ObjOutFile.Close
end function