New at VbScript so please include all lines if you can.
I have
Source-folder C:\s\ with files with names et_v01.txt, et_v02.txt etc. Destination-folder C:\d\ I only want the latest file to be COPIED from S to D which would be et_v02 since we'll use DateLastModified.
Bonus at destination only keep the latest file if it runs next time when a new version comes in. Thanks in advance and I have searched for this but the others had less than criteria and etc.
Option Explicit
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objSTR, objEND, objTYP, objEXT, objKEY, objFILE
Dim Folder, SubFolder
objSTR = "C:\s\"
objEND = "C:\d\"
For Each objFILE in objFSO.GetFolder(objSTR).Files
If objFILE.DateLastModified > DateAdd("d",-4,now) then
objFILE.Copy objEND
End If
Next
Here try this version:
Option Explicit
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strSource, strDestination
strSource = "C:\s\"
strDestination = "C:\d\"
Dim objFile, objOldestFileSoFar
For Each objFile in objFSO.GetFolder(strSource).Files
If Not IsEmpty(objOldestFileSoFar) Then
If objFile.DateLastModified > objOldestFileSoFar.DateLastModified Then
Set objOldestFileSoFar = objFile
End If
Else 'This is the first loop, i.e. we have no previous "last mod" to compare against.
Set objOldestFileSoFar = objFile
End If
Next
objOldestFileSoFar.Copy strDestination
Also, I've cleaned up your code a bit to get rid of unused declarations and to apply better naming to your variables. Take those as suggestions if you like, but just keep in mind that adhering to conventions is important.
Related
I want to load all files of a directory into an array with vbscipt/hta in order to sort and "call" them later by index. I've tried something like this, but it's not working:
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFileFolder = "C:\"
Set objFolder = objFSO.GetFolder(objFileFolder)
Set colFiles = objFolder.Files
dim arrFileList()
For Each objFile in colFiles
ReDim Preserve arrFileList(UBound(arrFileList) + 1)
FileList(UBound(arrFileList)) = objFile.Name
Next
I'd be grateful for any help! THX in advance
You need to change two things, please see new code below. Comments in line.
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFileFolder = "C:\"
Set objFolder = objFSO.GetFolder(objFileFolder)
Set colFiles = objFolder.Files
dim arrFileList()
ReDim Preserve arrFileList(0) 'If you wish to use the array UBound later on you must redim this here
For Each objFile in colFiles
ReDim Preserve arrFileList(UBound(arrFileList) + 1)
arrFileList(UBound(arrFileList)) = objFile.Name ' Here you were calling FileList, not arrFileList
Next
You could further tidy / improve this code as arrFileList(0) will have no value upon finishing.
I have a script already which can perform a saveas routine for file names that begin with certain characters.
This is the script below.
'launch Excel and open file
Const xlExcel8 = 56
Const xlOpenXMLWorkbook = 51
Set fso = CreateObject("Scripting.FileSystemObject")
Set xlObj = CreateObject("Excel.Application")
Set re = New RegExp
re.Pattern = "^ABC.*\.xlsx$"
re.IgnoreCase = True
For Each f In fso.GetFolder("C:\Users\Jimbo\Documents\_ThisWeek").Files
If re.Test(f.Name) Then
Set xlFile = xlObj.WorkBooks.Open(f.Path)
xlObj.DisplayAlerts = False
xlfile.SaveAs "C:\Users\Jimbo\Documents\_ThisWeek\Weekly Feed File.xls", xlExcel8
xlFile.Close True
End If
xlObj.DisplayAlerts = True
Next
Set re = New RegExp
re.Pattern = "^ABC.*\.xlsx$"
re.IgnoreCase = True
For Each f In fso.GetFolder("C:\Users\Jimbo\Documents\_ThisWeek").Files
If re.Test(f.Name) Then
fso.Deletefile(f.Path)
End If
Next
xlObj.Quit
Can anyone pls assist with updating the script to rename a file instead of performing a saveas?
This is an extremely simple example.
I don't have enough to go on for how you want to rename the file so you need to fill in that logic. I just defined a variable strName that holds a string value for an example.
You would want to set strName inside the If statement to something that works for you and changes on each loop.
If the path or name will be complex, make sure you double quote the variable.
'rename files from one folder to another
option explicit
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim strPath: strPath = "C:\Users\Jimbo\Documents\_AnotherFolder\"
Dim strName: strName = "SetYourNameHere.xls"
Dim re: Set re = New RegExp
Dim oFile
re.Pattern = "^ABC.*\.xlsx$"
re.IgnoreCase = True
For Each oFile In fso.GetFolder("C:\Users\Jimbo\Documents\_ThisWeek").Files
If re.Test(oFile.Name) Then
oFile.move strPath
oFile.name = strName
End If
Next
You already have the file object. Just move it with it's own method to your other folder then use it's name property to set the value to what you want the name to be.
You should add verification that the file doesn't already exist in the folder and handle that situation gracefully.
You can rename a file by using the MoveFile Method
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Fso.MoveFile "Test.txt", "Test2.txt"
I have a folder C:\test\ that has multiple .txt files which I need to append to one output text file. Using FSO and TextStream I can write the files explicitly with no problem in this manner:
Public Sub test()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Const Path As String = "C:\test\"
Dim helloWorld As Object
Set helloWorld = FSO.CreateTextFile(FileName:=(Path & "helloworld.txt"), OverWrite:=True, Unicode:=False)
helloWorld.WriteLine FSO.GetFile("C:\test\Product_ID_update.txt").OpenAsTextStream(ForReading).ReadAll
helloWorld.WriteLine FSO.GetFile("C:\test\RPT-4475.txt").OpenAsTextStream(ForReading).ReadAll
helloWorld.Close
End Sub
It works perfectly, but I have hundreds of files to append so it would be crazy to type them all out, so I wrote some code to put all the file names into an array, then loop over each index to generate the file path. Here is the code:
Sub Combine_Text_Files2()
Dim InputDirPath As String
InputDirPath = "C:\test\"
Dim InputFileType As String
InputFileType = "*.txt"
Dim OutputDirPath As String
OutputDirPath = "C:\test\"
Dim OutputFileName As String
OutputFileName = "_CombinedOutput.txt"
Dim InputFileName As String
InputFileName = Dir$(InputDirPath & InputFileType)
Dim FileArray() As String
Dim i As Integer: i = 0
Do Until InputFileName = vbNullString
ReDim Preserve FileArray(0 To i)
FileArray(i) = InputFileName
InputFileName = Dir$
i = i + 1
Loop
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Stream As Object
Set Stream = FSO.CreateTextFile((OutputDirPath & OutputFileName), OverWrite:=True, Unicode:=False)
Dim FileNameAndPath As String
For i = LBound(FileArray) To UBound(FileArray)
FileNameAndPath = (InputDirPath & FileArray(i))
Debug.Print ("Processing: " & FileNameAndPath)
Dim fileToCopy As File
Set fileToCopy = FSO.GetFile(FileNameAndPath)
Dim streamToCopy As TextStream
Set streamToCopy = fileToCopy.OpenAsTextStream(ForReading)
Dim text As String
text = streamToCopy.ReadAll
Stream.WriteLine FSO.GetFile(FileNameAndPath).OpenAsTextStream(ForReading).ReadAll
Debug.Print ("Appended to " & OutputFileName & ": " & FileNameAndPath)
Next i
Stream.Close
End Sub
The FileNameAndPath value gets updated correctly, and as it goes through the first Stream.WriteLine iteration, it appends only the first letter of the first file to the output file, then moves on to the next iteration, and on the next Stream.WriteLine it fails due to Invalid procedure call or argument.
I've been trying to debug this for quite a while but not certain what is causing this. Only thing I can think of that might be causing it is the array, because it's really the only thing that is different AFAIK... Any help would be greatly appreciated!
Additional details
If I comment out the WriteLine call it goes through the entire array, printing all file paths to immediate. As you can see I broke down the original one-liner into multiple steps for debugging.
Replicating it is easy:
Create a C:\test\ directory
Create two or more text files and add text content to each of them
Run the code in the VBE
I found the problem. The problem was not the code, it works fine (though I feel sure could be improved, I'll take it over to Code Review).
The problem was that some of the source files were actually originally Excel documents that became converted to .txt and apparently carried over some meta-data that Notepad ignored, but the VBA compiler did not know what to do with trying to put it into a String.
Lesson learned, perform a sanity check of your source data.
I have a VBS file that I am trying to use to determine what folders and files are in a certain directory. I believe I have the code written correctly, but whenever I try to write out the file or current directory I get a blank text document with nothing but the root directory written out. Any advice would be greatly appreciated.
Dim NewFile
Function GetFolders (strFolderPath)
Dim objCurrentFolder, colSubfolders, objFolder, files
Set objCurrentFolder = objFSO.GetFolder(strFolderPath)
Set colSubfolders = objCurrentFolder.SubFolders
For Each objFolder In colSubfolders
NewFile.WriteLine(" - " & objFolder.Path)
Set files = folder.Files
For each folderIdx In files
NewFile.WriteLine(" - "& folderIdx.Name)
Next
Call GetFolders (objFolder.Path)
Next
End Function
Dim fso, sFolder
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = Wscript.Arguments.Item(0)
If sFolder = "" Then
Wscript.Echo "No Folder parameter was passed"
Wscript.Quit
End If
Set NewFile = fso.CreateTextFile(sFolder&"\FileList.txt", True)
NewFile.WriteLine(sFolder)
Call GetFolders(sFolder)
NewFile.Close
You haven't payed sufficient attention to your variable naming. Your script is a good example of the reason why all VBScripts should start with the line:-
Option Explicit
This would highlight all the variables that haven't been declared which in turn will point out typos and inconsistencies in variable naming. Here is how I would write it:-
Option Explicit
Dim msFolder : msFolder = Wscript.Arguments.Item(0)
If msFolder = "" Then
Wscript.Echo "No Folder parameter was passed"
Wscript.Quit
End If
Dim mfso : Set mfso = CreateObject("Scripting.FileSystemObject")
Dim moTextStream : Set moTextStream = mfso.CreateTextFile(msFolder & "\FileList.txt", True)
moTextStream.WriteLine(msFolder)
WriteFolders mfso.GetFolder(msFolder)
moTextStream.Close
Sub WriteFolders(oParentFolder)
Dim oFolder
For Each oFolder In oParentFolder.SubFolders
moTextStream.WriteLine(" - " & oFolder.Path)
Dim oFile
For Each oFile In oFolder.Files
moTextStream.WriteLine(" - " & oFile.Name)
Next
WriteFolders oFolder
Next
End Sub
I need to create A set of empty folders, starting at 10, going to 180. This is the script I'm trying to use, but it just creates 10, and nothing else.
Option Explicit
Dim objFSO, objFolder, strDirectory, i
strDirectory = "\path\to\main\folder"
Set objFSO = CreateObject("Scripting.FileSystemObject")
i = 180
While i < 180
Set objFolder = objFSO.CreateFolder(strDirectory & i)
i = i+1
WScript.Quit
Wend
I'm pretty new to VBScript, so maybe the problem is obvious, but I just don't see it. I also tried using a For loop, but that didn't seem to work at all.
Thanks in advance to anyone who reads this.
I have modified your script as follows:
Option Explicit
Dim objFSO, objFolder, strDirectory, i
strDirectory = "C:\Temp\Test\folder"
Set objFSO = CreateObject("Scripting.FileSystemObject")
i = 10 '' <===== CHANGED!
While i < 180
Set objFolder = objFSO.CreateFolder(strDirectory & i)
i = i+1
''WScript.Quit '' <===== COMMENTED OUT!
Wend
With this script, I managed to create 180 folders.