I'm getting "Object required" runtime error when trying to run the following code. I am trying to find the most recent file saved in a folder and copy/rename it to another file name. My issue is the If statement to "Check for most recent file in folder" is returning Object errors.
I have followed other suggestions on here, but I can't seem to get over the Object error hurdles. If anyone can provide help for this newbie, I would appreciate it.
Option Explicit
Dim FSO, FSO2, FLD, FIL
Dim strFolder, strContent, strPath, tmpName, tmpName2, mostRecent, newfile
strFolder = "C:\Users\username\Documents\Mockup"
'Create the filesystem object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO2 = CreateObject("Scripting.FileSystemObject")
'loop through the folder and get the files
For Each FLD in FSO.GetFolder(strFolder).SubFolders
'Reset mostRecent to nothing
Set mostRecent = Nothing
Set mostRecent = CreateObject("Scripting.FileSystemObject")
For Each Fil In FLD.Files
If Fil = FLD & "\import.ARCHIVE" Then
FSO2.DeleteFile FLD & "\import.ARCHIVE"
Fil = FLD & "\import.tra"
End If
If Fil = FLD & "\import.tra" Then
tmpName = Replace(Fil, "import.tra", "import.ARCHIVE")'Replace(String, thisString, toThisString)
'Name Fil as tmpName
FSO.MoveFile Fil, tmpName
End If
'Check for most recent file in folder
If mostRecent Is Nothing Then
Set mostRecent = Fil
ElseIf Fil.DateCreated > mostRecent.DateCreated Then
Set mostRecent = Fil
End If
tmpName2 = Replace(mostRecent, "*.*", "import.tra")'Replace(String, thisString, toThisString)
FSO2.CopyFile mostRecent, tmpName2
Next
Next
'Clean up
Set FLD = Nothing
Set FSO = Nothing
Set FSO2 = Nothing
Set mostRecent = Nothing
just mask Set mostRecent = CreateObject("Scripting.FileSystemObject") will do.
We don't need a File System Object to get the date created for a file. I think you just mean to create an object. In vbscript, since you already 'dim mostRecent', when using Set, it will automatically assigned to an object.
Hope this will help you :)
Related
I have a directory of files that I want to Loop through and use part of their filename to replace text in a template doc.
For example one filename may be 'NV_AD32_city.dxf'. All files in the directory follow the same filename pattern of XX_XXXX_string.dxf, using two underscores.
I need to capture the string to the right of the first "_" and to the left of the "."so for this example that would be 'AD32_city'
How do I script to use capture that text of the active file to replace text in the template? I guess I need to create an object? But what is the object to use for the current file from a directory?
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Thx for the replies, guys. After several days of trying your code I am just not "getting it". I understand it is set up to take the part of the filename's string that I want but how do I tell the script to use the current file I am looping through? Here is my script so far. I have your code on line 20 under the Sub 'GetNewInputs'
Set fso = CreateObject("Scripting.FileSystemObject")
Option Explicit
Dim WritePath : WritePath = "S:\TempFolder\"
Dim OutFile : OutFile = "VEG_DXF-2-SHP_script-"
Dim WorkingFile : WorkingFile = GetFileContent(SelectFile())
Dim NewState, NewSection, NewArea
Dim OldState, OldSection, OldArea
Call GetNewInputs()
Call GetOldInputs()
Sub GetNewInputs()
NewState = UCase(InputBox("INPUT STATE:", _
"INPUT STATE", "SOCAL"))
NewSection = ("Section_" & InputBox("INPUT SECTION NUMBER:", _
"INPUT SECTION", "14"))
NewArea = "^[^_]+_(.*)\.dxf$"
End Sub
Private Sub GetOldInputs()
OldState = "XX"
OldSection = "_X"
OldArea = "ZZZZ"
End Sub
Function SelectFile()
SelectFile = vbNullString
Dim objShell : Set objShell = WScript.CreateObject("WScript.Shell")
Dim strMSHTA : strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
&"<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
&".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>"""
SelectFile = objShell.Exec(strMSHTA).StdOut.ReadLine()
If SelectFile = vbNullString Then
WScript.Echo "No file selected or not a text file."
WScript.Quit
End If
End Function
Private Function GetFileContent(filePath)
Dim objFS, objFile, objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.GetFile(filePath)
Set objTS = objFile.OpenAsTextStream(1, 0)
GetFileContent = objTS.Read(objFile.Size)
Set objTS = Nothing
End Function
For Each FileRefIn fso.GetFolder("S:\SOCAL\Section_14\Veg DXFs\").Files
NewFile = WorkingFile
NewFile = Replace(NewFile, OldState, NewState)
NewFile = Replace(NewFile, OldSection, NewSection)
NewFile = Replace(NewFile, OldArea, NewArea)
WriteFile NewFile, WritePath & OutFile & ".gms"
WScript.Echo NewArea
Next
Private Sub WriteFile(strLine,fileName)
On Error Resume Next
Dim objFSO, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Do Until IsObject(objFile)
Set objFile = objFSO.OpenTextFile(fileName, 8, True)
Loop
objFile.WriteLine strLine
objFile.Close
End Sub
Well, that’s actually two questions.
To enumerate files in a directory, you can use FileSystemObject, like this (untested)
const strFolderPath = "C:\Temp\Whatever"
set objFSO = CreateObject( "Scripting.FileSystemObject" )
set objFolder = objFSO.GetFolder( strFolderPath )
set colFiles = objFolder.Files
for each objFile in colFiles
' Do whatever you want with objFile
next
Here's the reference of those objects properties/methods.
And to extract portion of file names, you could use a regular expression.
Here’s some guide how to use'em in VBScript.
The following expression should work for you, it will capture the portion of that file names you asked for:
"^[^_]+_(.*)\.dxf$"
If you need to edit the content of the .dxf files, you will need to work within the AutoCAD VBA (Visual Basic for Applications) environment.
If that is the case, you will need to start with something like below:
GetObject("AutoCAD.Application.20")
CreateObject("AutoCAD.Application.20")
https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2015/ENU/AutoCAD-ActiveX/files/GUID-0225808C-8C91-407B-990C-15AB966FFFA8-htm.html
** Please take note that "VBA is no longer distributed with the AutoCAD installation; it must be downloaded and installed separately. The VBA Enabler for Autodesk AutoCAD can be downloaded here."
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 require a VBScript that renames a file and then moves it from one folder to another. The script currently renames the file correctly, but I cannot figure out how to move the file to the new folder after the renaming.
Below is the script as it exists.
Option Explicit
Const SAVE_LOCATION = "\\pccit2\Int\PC\Inbox"
Const strPath = "D:\Files\pak\VP\"
Const StrPrefix = "VP"
Dim FSO
Dim FLD
Dim fil
Dim strOldName
Dim strNewName
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLD = FSO.GetFolder(strPath)
For Each fil In FLD.Files
strOldName = fil.Path
strNewName = strPath & strPrefix & Right(strOldName, 10)
FSO.MoveFile strOldName, strNewName
Next
For Each fil In FLD.Files
If strNewName = 1 Then
FSO.MoveFile "\\pccit2\Int\PC\Inbox"
End If
Next
Set FLD = Nothing
Set FSO = Nothing
I have tried a variety ways of getting the file to move. Here are some other attempts:
If FSO.FileExists("D:\Files\pak\VP\*.*") Then
FSO.MoveFile "D:\Files\pak\VP\*.*", "\\pccit2\Int\PC\Inbox\*.*"
End If
Another attempt
If fil.FileExists("D:\Files\pak\VP\*.*") Then
fil.MoveFile "D:\Files\pak\VP\*.*" , "\\pccit2\Int\PC\Inbox\*.*"
End If
MoveFile is a method of the FileSystemObject object. It expects at least 2 arguments (source and destination), and wildcards can only be used in the source path, not in the destination path. The destination must be a file or folder path (with a trailing backslash if it's a folder). The respective method of file objects is Move, which can be called with just one argument (the destination path). Also, you can move and rename a file in one step. Just specify the destination path with the new file name.
For Each fil In FLD.Files
strNewName = FSO.BuildPath(SAVE_LOCATION, strPrefix & Right(fil.Name, 10))
fil.Move strNewName
Next
If you want to separate renaming from moving you can rename the file by simply changing its name:
For Each fil In FLD.Files
fil.Name = strPrefix & Right(fil.Name, 10)
fil.Move SAVE_LOCATION & "\"
Next
Use this
dim fs
set fs=Server.CreateObject("Scripting.FileSystemObject")
fs.MoveFile "c:\myfolder\*.*","c:\anotherfolder\"
set fs=nothing
First thing I am not an expert in writing VBScripts.
I have a requirement of deleting files & folders of remote systems with just 1 click. I was trying to build below VBScript but somehow it’s not working. I request any of your help to correct the same or with a new script that help me to fulfill the requirement. Any help in this regard is greatly appreciated, Thanks in Advance.
With the below:
C:\Test - is the directory from where I would like to delete the files & subfolders
C:\computerList.txt – is the text file contains all remote systems IP Address.
Const strPath = "C:\Test"
Set computerList = objfso.OpenTextFile ("C:\computerList.txt", 1)
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Call Search (strPath)
WScript.Echo"Done."
Sub Search(str)
Do While Not computerList.AtEndOfStream
strComputer = computerList.ReadLine
Dim objFolder, objSubFolder, objFile
Set objFolder = objFSO.GetFolder("\\" & strComputer & "\" & str)
For Each objFile In objFolder.Files
If objFile.DateLastModified < (Now() - 0) Then
objFile.Delete(True)
End If
Next
For Each objSubFolder In objFolder.SubFolders
Search(objSubFolder.Path)
' Files have been deleted, now see if
' the folder is empty.
If (objSubFolder.Files.Count = 0) Then
objSubFolder.Delete True
End If
Next
loop
End Sub
Regards,
Balaram Reddy
Your first problem is that you have the line order incorrect:
Set computerList = objfso.OpenTextFile ("C:\computerList.txt", 1)
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Should be
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set computerList = objfso.OpenTextFile ("C:\computerList.txt", 1)
You are using objfso before declaring it
When using a UNC path, you will need to use the folder's remote share name. If you have admin privileges on the remote pc use:
Const strPath = "c$\Test"
What is the simplest way in VB6 to loop through all the files in a specified folder directory and get their names?
sFilename = Dir(sFoldername)
Do While sFilename > ""
debug.print sFilename
sFilename = Dir()
Loop
Dim fso As New FileSystemObject
Dim fld As Folder
Dim fil As File
Set fld = fso.GetFolder("C:\My Folder")
For Each fil In fld.Files
Debug.Print fil.Name
Next
Set fil = Nothing
Set fld = Nothing
Set fso = Nothing
DJ's solution is simple and effective, just throwing out another one in case you need a little more functionality that the FileSystemObject can provide (requires a reference to the Microsoft Scripting Runtime).
Dim fso As New FileSystemObject
Dim fil As File
For Each fil In fso.GetFolder("C:\").Files
Debug.Print fil.Name
Next
'For VB6 very Tricky:
'Simply get the location of all project .frm files saved in your disk/project directory
Dim CountVal As Integer
CountVal = 0
cbo.Clear
sFilename = Dir(App.Path & "\Forms\")
Do While sFilename > ""
If (Right(sFilename, 4) = ".frm") Then
cbo.List(CountVal) = Left(sFilename, (Len(sFilename) - 4))
CountVal = CountVal + 1
End If
sFilename = Dir()
Loop
create button with name = browseButton
create filelistbox with name = List1
double click on button in design
and code should look like this
Private Sub browseButton_Click()
Dim path As String
path = "C:\My Folder"
List1.path() = path
List1.Pattern = "*.txt"
End Sub
done now run it
You can use the following demo code,
Dim fso As New FileSystemObject
Dim fld As Folder
Dim file As File
Set fld = fso.GetFolder("C:\vishnu")
For Each file In fld.Files
msgbox file.Name
Next