File array script

[Babscoole]

For some time I've been having an awful time trying to come up with a script to do several things with a set of files. Usually I'm able to find some script on the web which is close to what I need and then I can modify it as necessary. In this case though, I've only been able to find scripts that fit one of the specifications and am having a really hard time getting parts from different scripts to fit together. I know that it would probably be best to get something made "from scratch", but my skill level is well below what is necessary for getting the array put together and dealing with path and file name issues. I'm hoping somebody here would be kind enough to slap something together that fits the parameters set below so I can see where I'm messing up.

Here's the basic functionality of the script. Using FilesystemObject. There are three directories involved. A source, a destination, and an error directory. From the srcdir, get all files with a specific extension (.tif in this case), and check if they already exist in the destdir. If a file already exists in destdir, then move it to the errordir. If not, then move it to the destdir. After each file has been moved, each also needs to have some attributes changed (based on where it went), which I think is easiest by doing a objShell.Run "Attrib.exe" against it. Finally, it also has to keep count of how many went to the destdir and how many went to the errordir for display at the end of the script.

If anyone here cares to lend a hand (and code ), it would be much appreciated.

 

[markdmac]

What do you have so far?

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

 

[Babscoole]

Here's where I last left off with this. I realize that what is pasted here is completely messed up and unworkable, hence the start from scratch. I know that I need to declare the 3 directories as variables. The first thing that is kicking my butt is building the array of files (*.tif) from the srcdir and then being able to reference the files in the array by filename and extension (to facilitate building the command line for objShell.Run "Attrib.exe").

Dim colFiles, FCnt_FBGood, FCnt_FBErr, GoodMsg, ErrorMsg

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = "s:\FileBack\*.tif"
FCnt_FBErr = 0
FCnt_FBGood = 0

If objFSO.FileExists("CaseLibCheck.txt") And objFSO.FileExists("FileBack_Check.txt") Then
objShell.Popup "Access to FileBack and CaseLib folders is confirmed", 15, "File Access Okay", 0 + 64

For Each objFile In colFiles
If objFSO.FileExists("L:\") Then
FCnt_FBErr = FCnt_FBErr + 1
objFSO.MoveFile "S:\FileBack\*.tif", "S:\DayEnd_Errors\DE-FB_*.tif"
Else
FCnt_FBGood = FCnt_FBGood + 1
objFSO.MoveFile "S:\FileBack\*.tif", "L:\*.tif"
' for setting files to read-only with archive bit on
objFile.Attributes = objFile.Attributes + 33

End If
' objfile.attributes ("S:\FileBack\*.tif", 0)
' objFSO.DeleteFile "S:\FileBack\*.tif"
' dirFileBackFiles = Dir()


GoodMsg = "There were " & FCnt_FBGood & " good files copied to the CaseLib library"
ErrorMsg = "There were " & FCnt_FBErr & " error files placed in DayEnd_Errors folder"
objShell.Popup GoodMsg & (Chr(13)) & ErrorMsg, 15, "File Count Report", 0 + 64
Else
objShell.Popup "File Access problems for FileBack Files", 15, "File Access Error", 0 + 64
End If

 

[mrmovie]

'might give you some sort of a framework to work with


Set dicResults = CreateObject("Scripting.Dictionary")
Set objFldSrc = FSO.GetFolder(....)
For Each aFile In objFldSrc.Files
If LCase(Right(aFile.Name, 4)) = ".tif" Then
If FSO.FileExists(strDestFolder & "\" & aFile.Name) Then
intReturn = FSO.CopyFile or FileCopy?
If intReturn = 0 Then
dicResults.Add CStr(aFile.Name), "successfully transfered"
intCounter = intCounter + 1
Else
dicResults.Add CStr(aFile.Name), "failed transfered, copy error"
Call hmmError(aFile)
End If
Else
dicResults.Add CStr(aFile.Name), "already exists, wont copy"
Call hmmError(aFile)
End If

End If
Next

Sub attChange(ByVal objFile, ByVal blnSuccess, ByRef dicResults)
Dim intReturn
If blnSuccess = True Then
intReturn = WshShell.Run(Y)
Else
intReturn = WshShell.Run(X)
End If


End Sub



Sub hmmError(ByVal objFile, ByRef dicPassed)
Dim intReturn
intReturn = FSO.CopyFile/FileCopy to error folder?
If intReturn = 0 Then
dicPassed.Item(CStr(aFile.Name)) = dicPassed.Item(CStr(aFile.Name)) & " copied to error folder"
intCounter = intCounter + 1
Else
dicPassed.Item(CStr(aFile.Name)) = dicPassed.Item(CStr(aFile.Name)) & " failed copy to error folder"
Call hmmError(aFile)
End If
End Sub

 

[Babscoole]

Thanks mrmovie for the suggestion. I'm going to have to play with this and research dictionary arrays as I'm having trouble following some of the code and coming up with more questions than before.

 

[mrmovie]

you could scrap the dictionary object i only chucked it in there to gather logging information for you

 

[markdmac]

Just to chime in here, you don't need to look at the actual extension, you could use the FSO File Type as well. Here is a sample:

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.GetFolder("C:\TiffCheck")
tif= "Microsoft Office Document Imaging File"

For Each oFile In oFolder.Files
	If oFile.Type = tif Then
		WScript.Echo oFile.Name
	End If
Next

The above will catch both TIF and TIFF files, which using the last 4 characters would not.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

 

[mrmovie]

thanks Mark, i dont why but i always use the right/left functions, lazy i guess,

If oFile.Type = "tif" Then

 

[Babscoole]

Nice Mark. I probably can't use that since there are other image files in the srcdir that shouldn't be touched by this script.

Mrmovie's script sent me back to square one and I've actually come up with something semi-funtional, simple, and easy to read (pasted at the bottom of this message). A few quick things:

1) Does it look ok and does anyone see any glaring goofs?
2) The File Count isn't working and I can't quite figure out why?
3) Marc made a good point about Tiff files. Is there something I can do to If LCase(Right(objFile.Name, 4))... so that I can add multiple extensions?


Dim FCnt_FBGood, FCnt_FBErr, GoodMsg, ErrorMsg

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

strSource = "s:\FileBack\"
strDest = "L:\"
strError = "S:\DayEnd_Errors\"

GoodMsg = "There were " & FCnt_FBGood & " good files copied to the CaseLib library"
ErrorMsg = "There were " & FCnt_FBErr & " error files placed in DayEnd_Errors folder"

Set objFolder = objFSO.GetFolder(strSource)
FCnt_FBGood = 0
FCnt_FBErr = 0

For Each objFile In objFolder.Files
If LCase(Right(objFile.Name, 4)) = ".tif" Then
If ObjFSO.FileExists(strDest & objFile.Name) Then
objFile.Move strError
FCnt_FBErr = FCnt_FBErr+1
Else
objFile.Move strDest
FCnt_FBGood = FCnt_FBGood+1
objShell.Run "Attrib.exe +r " & strDest & objFile.name, 0, True
End If
End If
Next
objShell.Popup GoodMsg & (Chr(13)) & ErrorMsg, 15, "File Count Report", 0 + 64

 

[Babscoole]

Answered number three myself, by making the line:

If LCase(Right(objFile.Name, 4)) = ".tif" or LCase(Right(objFile.Name, 5)) = ".tiff" Then

There's probably some more elegant method, but this'll do.

 

[dm4ever]

If you have several extension, you may use a function like this which would make it easy to add new ones.

Function ExcludeFiles(strInput)
' 	On Error Resume Next
	
	Dim RegEx:	Set RegEx = New RegExp
	RegEx.Pattern = ".*\.(jpg|tiff|tif)$"
	RegEx.IgnoreCase = True
	ExcludeFiles = RegEx.Test(strInput)
End Function

So in your code, where you have the "If LCase(..=".tif"...." you would put "If ExcludeFiles(objFile.Name) Then....." The function returns True/False. As you can see. to add a new extension all you need is add an additional pipe (|) and the extension.

--------------------------------------------------------------------------------
dm4ever
My philosophy: K.I.S.S - Keep It Simple Stupid

 

[mrmovie]

perhaps add some named arguments so that you can call you script with different params?

perhaps use HTA so you can have nice little gui?

perhaps change your variable names,,,i got confused with strError

strErrorFld perhaps?

 

[mrmovie]

hmm you are using hungarian for your strings but your int? dbl? dont? FCnt_FBGood

i would also say you should trap your errors...

so

intReturn = 0
intReturn = WshShell.Run

etc

you can check the value of intReturn to make sure everything worked before claiming FCnt_FBGood = FCnt_FBGood+1

 

[Babscoole]

Thanks. I changed some of the naming convensions, hopefully it's easier to follow mrmovie. This script is actually a conversion from a Kix script, I kept the same names as in the original. I plan on having this and several other related ones tied into an HTA, but that will come after they are all in VBScript.

Tried adding
intReturn = 0
intReturn = WshShell.Run

but it threw an error and the counting function still isn't working. It doesn't seem to be adding +1 anyway, just appears to always be null. Here's where I'm at now:

Dim GoodFileCnt, BadFileCnt, GoodMsg, ErrorMsg

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

strSourceFld = "s:\FileBack\"
strDestFld = "L:\"
strErrorFld = "S:\DayEnd_Errors\"

GoodMsg = "There were " & FCnt_FBGood & " good files copied to the CaseLib library"
BadMsg = "There were " & FCnt_FBErr & " error files placed in DayEnd_Errors folder"

Set objFolder = objFSO.GetFolder(strSourceFld)
GoodFileCnt = 0
BadFileCnt = 0

For Each objFile In objFolder.Files
If LCase(Right(objFile.Name, 4)) = ".tif" or LCase(Right(objFile.Name, 5)) = ".tiff" Then
If ObjFSO.FileExists(strDestFld & objFile.Name) Then
BadFileCnt = BadFileCnt + 1
objFile.Move strErrorFld
Else
GoodFileCnt = GoodFileCnt + 1
objFile.Move strDest
' objShell.Run "Attrib.exe +r " & strDestFld & objFile.name, 0, True
End If
End If
Next
objShell.Popup GoodMsg & (Chr(13)) & ErrorMsg, 15, "File Count Report", 0 + 64

 

[mrmovie]

GoodMsg = "There were " & FCnt_FBGood & " good files copied to the CaseLib library"
BadMsg = "There were " & FCnt_FBErr & " error files placed in DayEnd_Errors folder"


comes before you update the FCnt_FBErr etc but you arent using those variable names anymore,,,so needs to change to include BadFileCnt etc and also move it after the For Next loop so you actually capture the results in your string

 

[Babscoole]

Thanks, that did the trick. I didn't think about when the data was being generated. Quick question that I thought of for when this gets rolled into an HTA, can a function be within a sub?

Here's what worked:

Dim GoodFileCnt, BadFileCnt, GoodMsg, ErrorMsg

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

strSourceFld = "s:\FileBack\"
strDestFld = "L:\"
strErrorFld = "S:\DayEnd_Errors\"

Set objFolder = objFSO.GetFolder(strSourceFld)


GoodFileCnt = 0
BadFileCnt = 0

For Each objFile In objFolder.Files
If ExcludeFiles(objFile.Name) Then
If ObjFSO.FileExists(strDestFld & objFile.Name) Then
BadFileCnt = BadFileCnt + 1
objFile.Move strErrorFld
Else
GoodFileCnt = GoodFileCnt + 1
objFile.Move strDestFld
' objShell.Run "Attrib.exe +r " & strDestFld & objFile.name, 0, True
End If
End If
Next
GoodMsg = "There were " & GoodFileCnt & " good files copied to the CaseLib library"
BadMsg = "There were " & BadFileCnt & " error files placed in DayEnd_Errors folder"

objShell.Popup GoodMsg & (Chr(13)) & BadMsg, 15, "File Count Report", 0 + 64

Function ExcludeFiles(strInput)
' On Error Resume Next

Dim RegEx: Set RegEx = New RegExp
RegEx.Pattern = ".*\.(tiff|tif)$"
RegEx.IgnoreCase = True
ExcludeFiles = RegEx.Test(strInput)
End Function

 

[mrmovie]

nope a function cant be within a sub.
but you can can have lots of functions or subs

 

[Babscoole]

Good to know. As mentioned earlier, I'm converting a bunch of Kix scripts into VBS and then tying them all together in an HTA. Given that functions and subs can't be within subs, I'm just going to have to be careful and try to keep each script from having too many functions and subs otherwise it will be very complicated to read through once they are all in an HTA.