`Ok, I was asked to be more specific in my question. I have an undetermined number of files in my folder, for example:
NV_A1_mainx.dxf
NV_A1_resx.dxf
NV_B1_mainx.dxf
NV_B1_motx.dxf
NV_B1_motlx.dxf
The folder is Looped processing each file based on the InStr "mainx”, “motx”, or “resx”. On “motx” type files I want the script to search and see if there additional matching type file “motlx”. If there is it will process one way. If not it will process a second way. The filenames will be different however the filename convention will always have two underscores “_” followed by the InStr characters I search on.
Using the files above as an example, I wish to write a statement so that when NV_A1_motx.dxf is about to be processed it will check to see if there is a matching NV_B1_motlx.dxf in the folder.
The problem is the last line of my script. How do I write that statement correctly for "motx" to see if there is also a "motlx" file present in the folder?
Thx... hope that clarifies better my intentions.
Set App = CreateObject("Illustrator.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder("S:\SOCAL\Section_13\Road DXFs")
Set DXFfile = SourceFolder.Files
Set DXFfolder = FSO.GetFolder(SourceFolder)
Dim FileRef
For Each FileRef In SourceFolder.Files
If Instr(FileRef,"motx") > 0 then
Call Motx(FileRef)
ElseIf Instr(FileRef,"mainx") > 0 then
Call Mainx(FileRef)
ElseIf Instr(FileRef,"resx") > 0 then
Call Resx(FileRef)
Else
Msgbox "File is not being found or some issue with script."
End If
Next
Sub Motx(FileRef)
If ((App.Documents.Count > 0) And (FileExists("S:\SOCAL\Section_13\Road DXFs\SOCAL_B2_motlx.dxf"))) Then
Else
Thank you for your input Jose. I was getting errors plugging the code in so what I did was just strip the code to the basics to see if your code would find the matching files. What I did was in the folder have just two files:
NV_B2_motlx.dvx and
NV_B2_motx.dvx
Testing with your script as so:
Set App = CreateObject("Illustrator.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder("S:\SOCAL\Section_13\Road DXFs")
Set DXFfile = SourceFolder.Files
Set DXFfolder = FSO.GetFolder(SourceFolder)
For Each FileRef In SourceFolder.Files
' default property of `FileRef` object is `Path`
If Instr( FileRef.Name, "motx", vbTextCompare) > 0 Then
I f fso.FileExists( fso.BuildPath( fso.GetParentFolderName( objFile.Path), _
Replace( FileRef.Name, "motx", "motlx", 1, -1, vbTextCompare))) Then
'motlx' exists
MsgBox "We have a match!"
Else
'motlx' does not exist
MsgBox "Sorry, no match"
End If
End If
Next
Running this I got the following error message: Type mismatch:'[string:"NV_B2_motlx.dxf"]' Code 800A000D Line 9 Char 5.
Maybe this code stub could help:
Dim FileRef
For Each FileRef In SourceFolder.Files
' default proprty of `FileRef` object is `Path`
If Instr( FileRef.Name, "motx", vbTextCompare) > 0 Then
If fso.FileExists( fso.BuildPath( fso.GetParentFolderName( objFile.Path), _
Replace( FileRef.Name, "motx", "motlx", 1, -1, vbTextCompare))) Then
'motlx' exists
Else
'motlx' does not exist
End If
Reference:
Functions (VBScript): InStr, Replace
FileSystemObject Properties: .Name, .Path
FileSystemObject Methods: .BuildPath, .GetParentFolderName
Related
I'm trying to write a VBScript that will check whether a file exists in a folder or not based on a partial number. If anything in the folder has this number in the string it can continue, if not an error needs to display saying it's not in the system. I've gotten a code that lets me know that the file DOES exist, but I can't get a NOT version to work. Any ideas?
Dim FSO, str1, fileName
str1 = "001234"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\Users\GDoe\Desktop\FolderA\")
For Each objFile In objFolder.Files
fileName = objFile.Name
If InStr(fileName, str1) Then
MsgBox("Proceed")
Exit For
End If
Next
Unfortunately the FileSystemObject's FileExists method does not support wildcards, so the straightforward approach is not possible here.
The code you posted in your question is basically how one would check for the existence of a file with a partial name with VBScript and the FileSystemObject. You can modify that code into a check for the absence of a file with some minor changes. Define a variable before the loop and set it to False, then instead of displaying a message box set that vriable to True when you find a matching file:
fileFound = False
For Each objFile In objFolder.Files
fileName = objFile.Name
If InStr(fileName, str1) Then
fileFound = True
Exit For
End If
Next
If fileFound Then
MsgBox("Proceed")
Else
MsgBox("File doesn't exist.")
End If
Alternatively, you could shell out and check the exit code of the dir command:
Function FileExists(path, namepart)
Set sh = CreateObject("WScript.Shell")
rc = sh.Run("cmd /c dir ""*" & path & "\" & namepart & "*""", 0, True)
FileExists = Not CBool(rc)
End Function
dir returns 0 if it finds matching file(s) and 1 if it doesn't. CBool() converts the integer return code into a boolean value (0 → False, 1 → True). The negation then corrects the logic from "false if found" to "true if found".
Of course you could also name the function FileMissing and remove the negation, so that the function returns True if no matching file is found. That's just a matter of what logic works best in your code.
Note that you need to run the command with cmd /c, because dir is a cmd.exe builtin command, not an executable.
I actually just found a way to answer my own question but if there's a better way I'd also love to know.
Dim FSO, str1, fileName
str1 = "-001239"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\Users\GDoe\Desktop\FolderA\")
For Each objFile In objFolder.Files
fileName=objFile.Name
If InStr(fileName, str1) Then
MsgBox("Proceed")
Exit For
End If
Next
If InStr(fileName, str1) = 0 Then
MsgBox("File doesn't Exist")
End If
I took the rule that if string2 is not found in an InStr command it returns 0. Setting the result = 0 shows if I don't have the file.
I am trying to add a sub-routine to a VBScript. In short, I am trying to see if one type of file exists, it will delete another file.
There will be files like:
SOCAL_CU59_res.dxf
SOCAL_CU59_main.dxf
SOCAL_CU59_mot.dxf
SOCAL_CU59_motl.dxf
but on occassion there may be a file with an "x" at the end of the filename:
SOCAL_CU59_resx.dxf
SOCAL_CU59_mainx.dxf
SOCAL_CU59_motx.dxf
SOCAL_CU59_motlx.dxf
They would all be in the same folder. The "x" file has priority. So if it exist I want to delete the matching file file without the "x".
Here is what I have so far but errors. The check filesize routine I added works great but it's after that I am having no luck:
Dim oFSO, sDirectoryPath, oFOLDER, oFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
sDirectoryPath = "S:\SOCAL\Section_11\Road DXFs\"
RecurseFolders sDirectoryPath
Sub RecurseFolders(sFolder)
'Here we set the oFolder object, note that its variable scope is within
'this sub, so you can set it many times and it's value will only be
'that of the sub that's currently running.
Set oFolder = oFSO.GetFolder(sFolder)
'Here we are looping through every file in the directory path.
For Each oFile In oFolder.Files
'This just checks for a file size less than 100Kb
If oFile.Size <= 1085 And Right(LCase(oFile.Name),3) = "dxf" Then
oFile.Delete True
End If
Next
For Each oFile In oFolder.Files
'This checks if there is a file with an 'x' at the end of filename
If FileExists (Right(oFile.Name),1) = "x" Then
oFile.Delete True
End If
Next
'Here we do the recursive bit. We need to loop through each folder in
'the directory too and call the same sub to ensure we check every folder
'in the path.
For Each oFolder In oFolder.SubFolders
RecurseFolders oFolder.Path
Next
End Sub
The script creates both files, but does not delete the file that does NOT have the "x". The error says for line 204, Char 5:
Wrong number of arguments or invalid property assignment: 'Right'
The line the error refers to is: If FileExists (Right(oFile.Name),1) = "x" Then.
You have a few inherent problems that you need to correct in order to do this properly. First, you need to make the parenthesis correction mentioned by Ansgar Wiechers. Second, you should remove the duplicate loop. There's no need to loop over all of the files multiple times. Finally, you should store the files to be deleted until after the loop has finished. Deleting a file while it is in the file set that is currently being looped over could produce unexpected results or unexplained errors.
With that said, here's how I would approach this. You'll note all of the corrections I've mentioned.
Dim oFSO, sDirectoryPath, oFOLDER, oFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
sDirectoryPath = "S:\SOCAL\Section_11\Road DXFs\"
Dim arrFilesToDelete() 'an empty dynamic array to hold files to be deleted later
Dim i = 0 'an iterator used to track the array pointer
RecurseFolders sDirectoryPath
DeleteExtraFiles arrFilesToDelete
Sub RecurseFolders(sFolder)
'Here we set the oFolder object, note that its variable scope is within
'this sub, so you can set it many times and it's value will only be
'that of the sub that's currently running.
Set oFolder = oFSO.GetFolder(sFolder)
'Here we are looping through every file in the directory path.
For Each oFile In oFolder.Files
'Is the file a "dxf" file
If LCase(Right(oFile.Name)) = "dxf" Then
'This just checks for a file size less than 100Kb
If oFile.Size <= 1085 And Right(LCase(oFile.Name),3) = "dxf" Then
End If
'This checks if there is an 'x' at the end of filename
If LCase(Right(oFile.Name) 5) = "x.dxf" Then
'if so, store its counterpart for deletion later
sBadFile = Replace(oFile.Name, "x.dxf", ".dxf")
ReDim Preserve arrFilesToDelete(i)
arrFilesToDelete(i) = oFile.Path & "\" & sBadFile
i = i + 1
End If
End If
Next
'Here we do the recursive bit. We need to loop through each folder in
'the directory too and call the same sub to ensure we check every folder
'in the path.
For Each oFolder In oFolder.SubFolders
RecurseFolders oFolder.Path
Next
End Sub
Sub DeleteExtraFiles(arrFiles)
For Each sFile in arrFiles
If oFSO.FileExists(sFile) Then
oFSO.DeleteFile sFile
End If
Next
End Sub
You put the inner closing parenthesis in the wrong place. The parameter 1 belongs to the function Right. Change this:
If FileExists (Right(oFile.Name),1) = "x" Then
into this:
If FileExists (Right(oFile.Name,1)) = "x" Then
With that said, there might be other issues with that line. VBScript doesn't have a built-in function FileExists and your code snippet doesn't reveal if that function is implemented elsewhere in your code, so whether passing it a character and comparing its return value to the character x actually makes sense is hard to say.
If you meant to use the FileSystemObject method FileExists you'd need to call it from the actual FileSystemObject instance:
If oFSO.FileExists(...) Then
and pass it a filename or path, not a single character or a boolean value.
If you want to test if for any given file foo.ext another file foox.ext exists, and in that case delete foo.ext you'd do something like this:
For Each oFile In oFolder.Files
xFilename = oFSO.GetBaseName(oFile) & "x." & oFSO.GetExtensionName(oFile)
If oFSO.FileExists(oFSO.BuildPath(oFile.Parent, xFilename)) Then
oFile.Delete True
End If
Next
I am changing product code, upgrade code and product name of MSI by editing MSI database.
With reference :- http://www.codeproject.com/Articles/383481/Editing-an-MSI-Database
I am able to change all parameters above but unable to change Package Code.
Suggest a way to change package code.
Found a way to do it with vbscript, just out of curiosity:
The "property #9" is the package code (revision number).
Set wi = CreateObject("WindowsInstaller.Installer")
Set summary = wi.SummaryInformation("your.msi", 2)
summary.Property(9) = "{PUT-NEW-GUID-HERE}"
summary.Persist
I'm guessing that the requirement here is to install the same MSI multiple times, which means they need to change that set of guids. However the more normal way to solve that problem is with MSINEWINSTANCE.
https://msdn.microsoft.com/en-us/library/aa370326(v=vs.85).aspx
https://msdn.microsoft.com/en-us/library/aa369528(v=vs.85).aspx
so that you are not changing the base MSI file every time.
Why do you even have the need to set the package code?
Its auto generated during each build.
Take a look at the documentation of the Package element:
http://wixtoolset.org/documentation/manual/v3/xsd/wix/package.html
"The package code GUID for a product or merge module. When compiling a product, this attribute should not be set in order to allow the package code to be generated for each build. When compiling a merge module, this attribute must be set to the modularization guid."
I needed it because MSI created cache in respective package code which restricts us to make another instance of application using MSI so I did this by
using (var database = new Database(#"D:\\Nirvana\\WorkingCopy\\trunk\\proj1\\installer.msi", DatabaseOpenMode.Direct))
{
database.SummaryInfo.RevisionNumber = "{" + Guid.NewGuid() + "}";
}
I extended the Nikolay script for generating a random GUID automatically. The script also support drag and drop and be called through arguments (so you can easily automate it through cscript) and it checks if the file is writable before creating Windows Installer object (if the file is locked by some application, like InstEd, it will throw an error).
Set objArgs = Wscript.Arguments
Set objFso = CreateObject("scripting.filesystemobject")
'iterate through all the arguments passed
' https://community.spiceworks.com/scripts/show/1653-drag-drop-vbscript-framework
For i = 0 to objArgs.count
on error resume next
'try and treat the argument like a folder
Set folder = objFso.GetFolder(objArgs(i))
'if we get an error, we know it is a file
If err.number <> 0 then
'this is not a folder, treat as file
ProcessFile(objArgs(i))
Else
'No error? This is a folder, process accordingly
For Each file In folder.Files
ProcessFile(file)
Next
End if
On Error Goto 0
Next
Function ProcessFile(sFilePath)
' http://www.wisesoft.co.uk/scripts/vbscript_file_modified_date.aspx
' Set objFile = objFSO.GetFile(sFilePath)
' MsgBox "Now processing file: " & CDATE( objFile.DateLastModified)
If Not IsWriteAccessible(sFilePath) Then WScript.Echo "Error persisting summary property stream" : Wscript.Quit 2
'Do something with the file here...
' https://stackoverflow.com/questions/31536349/set-package-code-of-msi-using-vbscript
Set installer = CreateObject("WindowsInstaller.Installer")
Set summary = installer.SummaryInformation(sFilePath, 2)
summary.Property(9) = CreateGuid()
summary.Persist
End Function
' https://stackoverflow.com/questions/968756/how-to-generate-a-guid-in-vbscript
Function CreateGuid()
CreateGuid = Left(CreateObject("Scriptlet.TypeLib").Guid,38)
End Function
' https://stackoverflow.com/questions/12300678/how-can-i-determine-if-a-file-is-locked-using-vbs
Function IsWriteAccessible(sFilePath)
' Strategy: Attempt to open the specified file in 'append' mode.
' Does not appear to change the 'modified' date on the file.
' Works with binary files as well as text files.
' Only 'ForAppending' is needed here. Define these constants
' outside of this function if you need them elsewhere in
' your source file.
Const ForReading = 1, ForWriting = 2, ForAppending = 8
IsWriteAccessible = False
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Dim nErr : nErr = 0
Dim sDesc : sDesc = ""
Dim oFile : Set oFile = oFso.OpenTextFile(sFilePath, ForAppending)
If Err.Number = 0 Then
oFile.Close
If Err Then
nErr = Err.Number
sDesc = Err.Description
Else
IsWriteAccessible = True
End if
Else
Select Case Err.Number
Case 70
' Permission denied because:
' - file is open by another process
' - read-only bit is set on file, *or*
' - NTFS Access Control List settings (ACLs) on file
' prevents access
Case Else
' 52 - Bad file name or number
' 53 - File not found
' 76 - Path not found
nErr = Err.Number
sDesc = Err.Description
End Select
End If
' The following two statements are superfluous. The VB6 garbage
' collector will free 'oFile' and 'oFso' when this function completes
' and they go out of scope. See Eric Lippert's article for more:
' http://blogs.msdn.com/b/ericlippert/archive/2004/04/28/when-are-you-required-to-set-objects-to-nothing.aspx
'Set oFile = Nothing
'Set oFso = Nothing
On Error GoTo 0
If nErr Then
Err.Raise nErr, , sDesc
End If
End Function
I modified this script so it would work over multiple directories. However when I run the script, I get an error message at line 6, char 3 "Invalid procedure call or argument". I'm new to VB scripting, but I would think that I can call a function with a variable as its argument.
Dim loc(2)
loc(0) = "C:\Users\Default\AppData\Local\Temp\"
for each path in loc
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path)
' delete all files in root folder
for each f in folder.Files
On Error Resume Next
name = f.name
f.Delete True
If Err Then
'WScript.Echo "Error deleting:" & Name & " - " & Err.Description
Else
'WScript.Echo "Deleted:" & Name
End If
On Error GoTo 0
Next
' delete all subfolders and files
For Each f In folder.SubFolders
On Error Resume Next
name = f.name
f.Delete True
If Err Then
'WScript.Echo "Error deleting:" & Name & " - " & Err.Description
Else
'WScript.Echo "Deleted:" & Name
End If
On Error GoTo 0
Next
Next
You're declaring an array whose highest index is 2. That'll be an array with three items: zero, one, and two. Then you're initializing only one of the items in that array, item zero. The first time through the loop, it's fine. The second time, it takes the second item from the array and sets path equal to it. That second array item is equal to Nothing, because you never initialized it to anything else, so path then equals Nothing. fso.GetFolder(path) fails when path equals Nothing.
When I change the array declaration to loc(0), it has just one item, item zero. And then your code works fine for me.
Dim loc(0)
That declaration looks surreally counterintuitive to me, but the compiler likes it.
Alternatively, you could initialize all three items in your original array:
loc(0) = "C:\Users\Default\AppData\Local\Temp\"
loc(1) = "C:\Users\Default\AppData\Local\Temp\blah"
loc(2) = "C:\Users\Default\AppData\Local\Temp\foobar"
...or whatever. But those paths should be real directories, otherwise fso.GetFolder() will fail because they don't exist. That error would look like this:
path.vbs(8, 3) Microsoft VBScript runtime error: Path not found
I am writing a VB Script to update some files on the network. Before beginning, I want to know if any of the files are locked. I'd like to do this before I actually do any updates.
I am aware that I can handle the error if the file is locked when I try to replace it, but I really want to know if any files are locked before I start updating any files.
Is there any way to see that a file is locked using VBS (apart from trying to replace it)?
This function determines whether a file of interest can be accessed in 'write' mode. This is not exactly the same as determining whether a file is locked by a process. Still, you may find that it works for your situation. (At least until something better comes along.)
This function will indicate that 'write' access is not possible when a file is locked by another process. However, it cannot distinguish that condition from other conditions that prevent 'write' access. For instance, 'write' access is also not possible if a file has its read-only bit set or possesses restrictive NTFS permissions. All of these conditions will result in 'permission denied' when a 'write' access attempt is made.
Also note that if a file is locked by another process, the answer returned by this function is reliable only at the moment the function is executed. So, concurrency problems are possible.
An exception is thrown if any of these conditions are found: 'file not found', 'path not found', or 'illegal file name' ('bad file name or number').
Function IsWriteAccessible(sFilePath)
' Strategy: Attempt to open the specified file in 'append' mode.
' Does not appear to change the 'modified' date on the file.
' Works with binary files as well as text files.
' Only 'ForAppending' is needed here. Define these constants
' outside of this function if you need them elsewhere in
' your source file.
Const ForReading = 1, ForWriting = 2, ForAppending = 8
IsWriteAccessible = False
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Dim nErr : nErr = 0
Dim sDesc : sDesc = ""
Dim oFile : Set oFile = oFso.OpenTextFile(sFilePath, ForAppending)
If Err.Number = 0 Then
oFile.Close
If Err Then
nErr = Err.Number
sDesc = Err.Description
Else
IsWriteAccessible = True
End if
Else
Select Case Err.Number
Case 70
' Permission denied because:
' - file is open by another process
' - read-only bit is set on file, *or*
' - NTFS Access Control List settings (ACLs) on file
' prevents access
Case Else
' 52 - Bad file name or number
' 53 - File not found
' 76 - Path not found
nErr = Err.Number
sDesc = Err.Description
End Select
End If
' The following two statements are superfluous. The VB6 garbage
' collector will free 'oFile' and 'oFso' when this function completes
' and they go out of scope. See Eric Lippert's article for more:
' http://blogs.msdn.com/b/ericlippert/archive/2004/04/28/when-are-you-required-to-set-objects-to-nothing.aspx
'Set oFile = Nothing
'Set oFso = Nothing
On Error GoTo 0
If nErr Then
Err.Raise nErr, , sDesc
End If
End Function
The script below tries to write to a file for 30 seconds and gives up after that. I needed this when all our users had to click on a script. Chances are that multiple users try to write at the same time. OpenCSV() tries to open the file 30 times with a delay of 1 second in between.
Const ForAppending = 8
currentDate = Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " " & Hour(Now) & ":" & Minute(Now) & ":" & Second(Now)
filepath = "\\network\path\file.csv"
Set oCSV = OpenCSV( filepath )
oCSV.WriteLine( currentDate )
oCSV.Close
Function OpenCSV( path )
Set oFS = CreateObject( "Scripting.FileSystemObject" )
For i = 0 To 30
On Error Resume Next
Set oFile = oFS.OpenTextFile( path, ForAppending, True )
If Not Err.Number = 70 Then
Set OpenCSV = oFile
Exit For
End If
On Error Goto 0
Wscript.Sleep 1000
Next
Set oFS = Nothing
Set oFile = Nothing
If Err.Number = 70 Then
MsgBox "File " & filepath & " is locked and timeout was exceeded.", vbCritical
WScript.Quit
End If
End Function
Or, more simply:
Assuming you already have a variable in your VBS named FileName, which contains the full filepath you want to test:
Dim oFso, oFile
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oFile = oFso.OpenTextFile(FileName, 8, True)
If Err.Number = 0 Then oFile.Close
Line 3 tries to open the file you want to test with append permissions enabled. e.g. it attempts to open the file with a write lock.
If opening the file with a write lock generates an error, then your VBS will error on the third line and not continue. At that point your error handling from wherever you called the VBS should kick in. The error message will be "Permission Denied" if you couldn't get a write lock.
If opening the file with a lock doesn't result in an error, then line 4 closes it again. You can now open the file or do whatever you want with it, confident that it doesn't have a write lock on it.