Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Help with VB script issue 1

Status
Not open for further replies.

quixter

Technical User
Aug 24, 2010
10
US
I have a script that I have pieced together to help my team out. The script decrypts files in a folder. Names the files, keeping original name and extension as .txt. Then archives them to another folder.

The issue I'm having is if there are multiple files the script completes one file (decrypts and archives) and then just archives the remaining without decrypting. The script is below. Any suggestions would be appreciated.

Main

Sub Main
Dim bWaitOnReturn: bWaitOnReturn = True

Dim sPassphrase: sPassphrase = "xxxxxxx"

Dim files: files = ListDir("C:\Brian\*.pgp")
For Each FileName in files
Dim sFileName_Input: sFileName_Input = FileName

dim sFileName_Output: sFileName_Output = Left(sFileName_Input, Len(sFileName_Input) - 4)

Dim sCommand_Text: sCommand_Text = Chr(34) & "C:\Program Files\GNU\GnuPG\gpg2.exe" & Chr(34) & " --batch --passphrase " & Chr(34) & sPassphrase & Chr(34) & " -o " & Chr(34) & sFileName_Output & Chr(34) & " -d " & Chr(34) & sFileName_Input & Chr(34)

Dim oWiSH_Shell: Set oWiSH_Shell = CreateObject("WScript.Shell")

oWiSH_Shell.Run sCommand_Text, iWindowStyle, bWaitOnReturn

Dim fso

Set objFSO = CreateObject("Scripting.FileSystemObject")

objFSO.MoveFile "C:\Brian\filename*.txt.pgp" , "C:\Brian\Archive\"

Set oWiSH_Shell = Nothing
Next
End Sub

' Returns an array with the file names that match Path.
' The Path string may contain the wildcard characters "*"
' and "?" in the file name component. The same rules apply
' as with the MSDOS DIR command.
' If Path is a directory, the contents of this directory is listed.
' If Path is empty, the current directory is listed.

Public Function ListDir (ByVal Path)
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
If Path = "" then Path = "*.*"
Dim Parent, Filter
if fso.FolderExists(Path) then ' Path is a directory
Parent = Path
Filter = "*"
Else
Parent = fso.GetParentFolderName(Path)
If Parent = "" Then If Right(Path,1) = ":" Then Parent = Path: Else Parent = "."
Filter = fso.GetFileName(Path)
If Filter = "" Then Filter = "*"
End If
ReDim a(10)
Dim n: n = 0
Dim Folder: Set Folder = fso.GetFolder(Parent)
Dim Files: Set Files = Folder.Files
Dim File
For Each File In Files
If CompareFileName(File.Name,Filter) Then
If n > UBound(a) Then ReDim Preserve a(n*2)
a(n) = File.Path
n = n + 1
End If
Next
ReDim Preserve a(n-1)
ListDir = a
End Function

Private Function CompareFileName (ByVal Name, ByVal Filter) ' (recursive)
CompareFileName = False
Dim np, fp: np = 1: fp = 1
Do
If fp > Len(Filter) Then CompareFileName = np > len(name): Exit Function
If Mid(Filter,fp) = ".*" Then ' special case: ".*" at end of filter
If np > Len(Name) Then CompareFileName = True: Exit Function
End If
If Mid(Filter,fp) = "." Then ' special case: "." at end of filter
CompareFileName = np > Len(Name): Exit Function
End If
Dim fc: fc = Mid(Filter,fp,1): fp = fp + 1
Select Case fc
Case "*"
CompareFileName = CompareFileName2(name,np,filter,fp)
Exit Function
Case "?"
If np <= Len(Name) And Mid(Name,np,1) <> "." Then np = np + 1
Case Else
If np > Len(Name) Then Exit Function
Dim nc: nc = Mid(Name,np,1): np = np + 1
If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
End Select
Loop
End Function

Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter, ByVal fp0)
Dim fp: fp = fp0
Dim fc2
Do ' skip over "*" and "?" characters in filter
If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
fc2 = Mid(Filter,fp,1): fp = fp + 1
If fc2 <> "*" And fc2 <> "?" Then Exit Do
Loop
If fc2 = "." Then
If Mid(Filter,fp) = "*" Then ' special case: ".*" at end of filter
CompareFileName2 = True: Exit Function
End If
If fp > Len(Filter) Then ' special case: "." at end of filter
CompareFileName2 = InStr(np0,Name,".") = 0: Exit Function
End If
End If
Dim np
For np = np0 To Len(Name)
Dim nc: nc = Mid(Name,np,1)
If StrComp(fc2,nc,vbTextCompare)=0 Then
If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
CompareFileName2 = True: Exit Function
End If
End If
Next
CompareFileName2 = False
End Function

Thanks ahead of time.........
 
Code:
objFSO.MoveFile "C:\Brian\filename*.txt.pgp" , "C:\Brian\Archive\"

Try moving the above line out of the for next loop. Otherwise, the first time through the loop it will move all the files.
 
Thanks, may not get a chance to try that until Tuesday, but it seems like that would certainly do it.
 
It worked once I moved the word next after the following line, Thanks Greatly appreciated the help.


oWiSH_Shell.Run sCommand_Text, iWindowStyle, bWaitOnReturn

next
 
OK an error popped up today. I didnt test this the other day because it wasn't giving me this issue before. the script now fails if there are no files.

I Believe I need to use the following as the first call:

Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(""C:\Brian\*.pgp")Then

But I can't get it to continue with running the script if a file is found, or quit if no file is found.
 
Have you tried this ?
If Not objFSO.FileExists("C:\Brian\*.pgp") Then Exit Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
If I write it as:

Main

Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists("C:\Brian\*.pgp") Then Exit Sub


Sub Main
Dim bWaitOnReturn: bWaitOnReturn = True

It tells me I have an invalid exit statement.
 
write it as:
Main
Sub Main
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists("C:\Brian\*.pgp") Then Exit Sub
Dim bWaitOnReturn: bWaitOnReturn = True
...

or as:
Dim objFSO: Set objFSO = CreateObject
If objFSO.FileExists("C:\Brian\*.pgp") Then
Main
End If
Sub Main
Dim bWaitOnReturn: bWaitOnReturn = True
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
PHV,
Really appreciate the input and your time. You developers are a tuff bunch, I give all the credit in the owrld, this is really frustrating when you fix one thing and break another in the process.

Anyways, I tried both ways and it's not throwing an error, but it's not processing the files when they do exist either.
 
Try adding the following conditional:
Code:
Dim files: files = ListDir("C:\Brian\*.pgp")
For Each FileName in files

to:

Code:
Dim files: files = ListDir("C:\Brian\*.pgp")
[COLOR=red]if files.count = 0 then
  wscript.echo("no files to process")
  wscript.quit
end if[/color]

For Each FileName in files...
 
Hi Jges,

I see what you did there, I may learn some of this stuff yet. I want to make sure I understood where to place that.

Main

Sub Main

Dim bWaitOnReturn: bWaitOnReturn = True

Dim sPassphrase: sPassphrase = "revrunner1"

Dim files: files = ListDir("C:\Brian\*.pgp")

if files.count = 0 then
wscript.echo("no files to process")
wscript.quit
end if

For Each FileName in files
Dim sFileName_Input: sFileName_Input = FileName

dim sFileName_Output: sFileName_Output = Left(sFileName_Input, Len(sFileName_Input) - 4)


If that's correct then it's throwing back an error

line 11
char 1
Object required: 'files'
 
I didn't look very hard at the 'ListDir' function and I assumed it would return a collection; I see now that it does not, instead it returns an array.

Instead of
Code:
if files.count = 0...

try:
Code:
if ubound(files) = 0...

I don't have your entire script running to try it out, but I think that may fix it.
 
Yea, realize its hard without having the entire code.

It was after we moved the word "next" to before the file move that brought up this issue. It fixed the multiple file issue which I thought for sure put this to rest. So the issue is actually with the file move part... I believe, right?

next

Dim fso
Set objFSO = CreateObject("Scripting.FileSystemObject")

objFSO.MoveFile "C:\Brian\Tallahassee*.txt.pgp" , "C:\Brian\Archive\"

Set oWiSH_Shell = Nothing


When I made the change that you suggested above it now gives me a file not found on line 31. Which is the line for the file copy.

So it seems that it didn't quit the script but continued on after the new code. Would it be easier to fix it in the move file portion of the code?


 
Do you really have file(s) named Tallahassee<optional text>.txt.pgp?

Is Tallahassee a folder or is it part of a file's name? Are you looking to move the files from the Tallahassee folder, or all files from the Brian folder that start with the characters 'Tallahassee'? I ask because at the beginning of the script you have
Code:
Dim files: files = ListDir("C:\Brian\*.pgp")
So it appears that you are loading in files from C:\Brian and your move code specifies files from C:\Brian that start with 'Tallahassee'. You must not have a file that starts with 'Tallahassee' if you are getting the file not found error.
 
Tallahasse is part of the file name. That is the issue. I need the script to stop if it does not find files. Currently it hangs on the file move if there are no files.
 
What about this ?
Code:
...
Dim files: files = ListDir("C:\Brian\*.pgp")
Dim NumOfFiles: NumOfFiles = 0
If IsArray(files) Then
 For Each FileName in files
  NumOfFiles = NumOfFiles + 1
  ...
 Next
End If
If NumOfFiles = 0 Then
  WScript.Echo "no files to process"  
  WScript.Quit
End If
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.MoveFile "C:\Brian\filename*.txt.pgp" , "C:\Brian\Archive\"
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
So you want to process ALL of the .pgp files, but archive ONLY those that start with Tallahassee?

How about we just ignore the file not found error?

Code:
On Error Resume Next
objFSO.MoveFile "C:\Brian\Tallahassee*.txt.pgp" , "C:\Brian\Archive\"
On Error Goto 0
 
Jges, that seems to work perfectly, greatly appreciated!!! Hopefully I'm not speaking to soon this time, but I tested it upside down and all around this time.

PHV, thanks as well.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top