Question on getting file lists from a folder, changing drive

[parkerthompson]

I found this script in the forum.
How can I use a variable for the drive designation?

Let>driveletter=L:\

GetAllSubFolders "P:\" replace P:\ with %driveletter%


Thanks,
Frank

Let>driveletter=L:\

Code: Select all

 
Let>VBS_TIMEOUT=20000 
VBSTART 

Sub GetAllSubFolders(foldername) 
On Error Resume Next 
Dim f, fc 
Set f = fs.GetFolder(foldername) 
Set fc = f.SubFolders 
For Each f in fc 
outf.WriteLine f.Path 
GetAllSubFolders foldername & "\" & f.name 
Next 
End Sub 

Dim fs, d, foldername 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set outf = fs.OpenTextFile("C:\~PDrive~.txt", 2, True) 

GetAllSubFolders "P:\" 
outf.Close 
Set fs = Nothing 
Set outf = Nothing 
MsgBox "All done" 

VBEND 

VBRUN>GetAllSubFolders 
[code]

[JRL]

Frank,

I'm sorely lacking in VB skills. The way I'd handle this would be to use DOS. Something Like:

Let>drive=L
Run>cmd /c dir %drive%:\*.* /ad /s /b > C:\~%drive%Drive~.txt

If you need to use VB script then I'd write the whole thing out to another macro file then execute that macro.

Heres the example:

Input>drive,drive letter to GetAllSubFolders...
If>drive=,finish

IfFileExists>C:\~%drive%Drive~.scp
DeleteFile>C:\~%drive%Drive~.scp
EndIf

WriteLn>C:\~%drive%Drive~.scp,wresult,Let>VBS_TIMEOUT=20000
WriteLn>C:\~%drive%Drive~.scp,wresult,VBSTART

WriteLn>C:\~%drive%Drive~.scp,wresult,Sub GetAllSubFolders(foldername)
WriteLn>C:\~%drive%Drive~.scp,wresult,On Error Resume Next
WriteLn>C:\~%drive%Drive~.scp,wresult,Dim f, fc
WriteLn>C:\~%drive%Drive~.scp,wresult,Set f = fs.GetFolder(foldername)
WriteLn>C:\~%drive%Drive~.scp,wresult,Set fc = f.SubFolders
WriteLn>C:\~%drive%Drive~.scp,wresult,For Each f in fc
WriteLn>C:\~%drive%Drive~.scp,wresult,outf.WriteLine f.Path
WriteLn>C:\~%drive%Drive~.scp,wresult,GetAllSubFolders foldername & "\" & f.name
WriteLn>C:\~%drive%Drive~.scp,wresult,Next
WriteLn>C:\~%drive%Drive~.scp,wresult,End Sub

WriteLn>C:\~%drive%Drive~.scp,wresult,Dim fs, d, foldername
WriteLn>C:\~%drive%Drive~.scp,wresult,Set fs = CreateObject("Scripting.FileSystemObject")
WriteLn>C:\~%drive%Drive~.scp,wresult,Set outf = fs.OpenTextFile("C:\~%drive%Drive~.txt", 2, True)

WriteLn>C:\~%drive%Drive~.scp,wresult,GetAllSubFolders "%drive%:\"
WriteLn>C:\~%drive%Drive~.scp,wresult,outf.Close
WriteLn>C:\~%drive%Drive~.scp,wresult,Set fs = Nothing
WriteLn>C:\~%drive%Drive~.scp,wresult,Set outf = Nothing
WriteLn>C:\~%drive%Drive~.scp,wresult,MsgBox "All done"

WriteLn>C:\~%drive%Drive~.scp,wresult,VBEND

WriteLn>C:\~%drive%Drive~.scp,wresult,VBRUN>GetAllSubFolders

Macro>C:\~%drive%Drive~.scp
Label>finish


Hope this helps,
Dick

[parkerthompson]

I dumped the Windows script and added your 2 lines with some modification and got it to work.
The script is all over the place, but it works.

I think Macro Scheduler is a really great product.
I really appreciate the context sensitive help.

I remember the good old days using FoxPro 2.6 they had the same help system, until MS took them over and gaffed it.

Here it is, as it is not for the faint of heart or some one who actually programs.
Unfortunately I can't devote a lot of time to programming.

All it does is copy the contents of a camera and moves it to a network drive.
The foremen at our job sites are computer deficient, but then again I'm carpentry deficient.

Label>start
Let>a=0
Let>frompicture=E:\
Let>projectdrive=m:
Let>drive=Z
Let>q=1
Readln>c:\whichdir.txt,1,jobnumber
Readln>c:\cameradrive.txt,1,frompicture
Let>frompicturea= "
Concat>frompicturea,frompicture
Concat>frompicturea,"
Let>tojob=projectdrive
Concat>projectdrive,\
Concat>projectdrive,jobnumber
Concat>projectdrive,\
Let>file_names_count=0
Day>tday
Month>tmonth
Year>tyear
Let>Current=tmonth
Concat>Current,tday
Concat>Current,tyear
Let>blabla=GetAllSubFolders "E:\"

Remark>checks to see if drive is available.

If>Jobnumber=##NOFILE##,realstartjob
If>frompicture=##NOFILE##,edir
Goto>cameraloop
Label>changedrive
Input>newdrive,Drive Letter for Memory card or Camera I.E. e:\
Deletefile>c:\cameradrive.txt
Writeln>c:\cameradrive.txt,%newdrive%
Message>You'll need to restart program
goto>end

Label>cameraloop
readln>c:\cameradrive.txt,1,frompicture
Let>a=a+1
IfDirExists>frompicture,withinedir
Ask>If camera is not plugged in please do so now.,cameraplug
If>a=4,error
If>cameraplug=YES,cameraloop

Rem>File Count To Copy

Goto>withinedir
Let>q=1
Label>edir
Input>drive,Drive Letter?,E:\
Deletefile>c:\cameradrive.txt
Writeln>c:\cameradrive.txt,%drive%
Run>cmd /c dir %drive%*.* /ad /s /b > C:\thedrive.txt
Message>You'll need to restart program
Goto>end

Label>withinedir
Readln>C:\thedrive.txt,q,folder
If>folder=##EOF##,moreedir
Let>q=q+1
Goto>withinedir
Label>moreedir
Let>q=q-1
Readln>C:\thedrive.txt,q,folder
Concat>folder,\*.*
CountFiles>folder,file_names_count,0
Label>endedir

Label>Startdiag

Dialog>Dialog1
Caption=Please Check Drive and Job Number if incorrect press fix:
Width=445
Height=250
Top=170
Left=84
Max=1
Min=1
Close=1
Resize=1
Label=Drive to copy pictures from,136,32,true
Label=Project to copy pictures to,136,64,true
Label=Copy File Count,136,96,true
Label=Please review from location and to location if they look good press OK,72,136,true
Edit=msEdit1,296,24,121,%frompicture%
Edit=msEdit2,296,56,121,%projectdrive%
Button=OK,64,168,75,25,2
Button=Change Job,168,168,75,25,3
Edit=msEdit3,296,88,121,%file_names_count%
Button=Cancel,352,168,75,25,5
Button=Newdrive,264,168,75,25,4
EndDialog>Dialog1


Show>Dialog1,b
If>b=2,allgood
If>b=3,badstuff
If>b=4,edir
If>b=5,end

Label>badstuff
CloseDialog>Dialog1
Goto>realstartjob
Goto>end

Label>allgood
CloseDialog>Dialog1
let>movedos=copy
concat>movedos, "
concat>movedos,%folder%
concat>movedos,"
concat>movedos, "
concat>movedos,%projectdrive%
concat>movedos,photos\
concat>movedos,current
concat>movedos,"
let>makedir=md
concat>makedir, "
concat>makedir,%projectdrive%
concat>makedir,photos\
concat>makedir,current
concat>makedir,"
Run>cmd.exe /c %makedir%
Run>cmd.exe /c %movedos%


Goto>end

Label>error
Message>For some reason you camera or memory is not connected contact IT, or change the drive letter.

Goto>end

Label>realstartjob
Run>cmd.exe /c dir m:\ > m:\directory.txt
Let>COMSPEC=Cmd.exe

Deletefile>c:\testtextfile1.txt
Deletefile>c:\whichdir.txt
Let>c=7
Label>startjob
ReadLn>c:\testtextfile.txt,c,linejob
If>linejob=##EOF##,finishjob
If>linejob=,cleanlinejob
Midstr>linejob,40,200,somevaluejob
WriteLn>c:\testtextfile1.txt,somevaluejob
Label>cleanlinejob
Let>c=c+1
Goto>startjob
Label>finishjob

IfFileExists>c:\~list_script~.scp
DeleteFile>c:\~list_script~.scp
EndIf

Dialog>Dialog2
Caption=Click Ok to View a List of Available Jobs.
Width=445
Height=250
Top=100
Left=CENTER
Label=Click to see Available Jobs List,120,72
Button=See List,184,176,75,25,3
EndDialog>Dialog2


show>dialog2,d
if>d=3,Updatejob
if>d=2,exitjob
Wait>0.2
Macro>c:\~list_script~.scp
Let>list_result=list_var_%MACRO_RESULT%
rem>MDL>%list_result%
Writeln>c:\whichdir.txt,%list_result%
Wait>1

SRT>Updatejob
Let>e=0
//Change c:\testtextfile.txt in the line below to the file that contains your data list.
ReadFile>c:\testtextfile1.txt,listjob
Separate>listjob,%CRLF%,list_var

WriteLn>c:\~list_script~.scp,wresult,Dialog>DialogList
WriteLn>c:\~list_script~.scp,wresult,Caption=Pick from list
WriteLn>c:\~list_script~.scp,wresult,Width=400
WriteLn>c:\~list_script~.scp,wresult,Height=600
WriteLn>c:\~list_script~.scp,wresult,Top=100
WriteLn>c:\~list_script~.scp,wresult,Left=CENTER
Repeat>e
Let>e=e+1
Let>ypos=30*%e%
Let>bname=list_var_%e%
WriteLn>c:\~list_script~.scp,wresult,Button=%bname%,10,%ypos%,380,25,%e%
Until>e,list_var_count
WriteLn>c:\~list_script~.scp,wresult,EndDialog>DialogList
WriteLn>c:\~list_script~.scp,wresult,show>DialogList,MACRO_RESULT
WriteLn>c:\~list_script~.scp,wresult,CloseDialog>DialogList
END>Updatejob
Message>You'll need to restart program

Goto>end

Label>exitjob

Message>You'll need to restart program

Label>end

[JRL]

Frank,

Took a quick look at your program and I noticed that some of your WriteLn> functions are incomplete. WrtieLn> needs three parameters and some of yours only have two. Those are going to give you headaches if you don't get them fixed.

Specifically:

Writeln>c:\cameradrive.txt,%newdrive%
Should be:
Writeln>c:\cameradrive.txt,wresult,%newdrive%

Writeln>c:\cameradrive.txt,%drive%
Should be:
Writeln>c:\cameradrive.txt,wresult,%drive%

WriteLn>c:\testtextfile1.txt,somevaluejob
Should be:
WriteLn>c:\testtextfile1.txt,wresult,somevaluejob

Writeln>c:\whichdir.txt,%list_result%
Should be:
Writeln>c:\whichdir.txt,wresult,%list_result%

I'll take a longer look later. I'll let you know if I see anything else.
Good Luck,
Dick

[parkerthompson]

Thank you for your input, I've made the changes your sugested.

Still a few issues, but it's usable, it will only be going on 6 or 7 computers.

Take Care,
Frank

[kpassaur]

Back to the origional question, how can you pass a variable to this script? It is very fast and works great, but I in need to have a variable instead of p:\.

I have used the dos dir command in the past and it takes much longer than this. I do think it would be a nice enhancement if Macro Scheduler had a command that did it like file list.

[Marcus Tettmar]

Which script are you referring to? If you want to pass a variable to a VBScript subroutine or function just do so with the VBRun or VBEval command.

Clearly you'd need the VBScript code to be inside a Sub or Function first. The OP's script had some VBScript code that was not in a sub or function so could not be called by Macro Scheduler code - it just runs when the VBSTART/VBEND block is reached. Instead put the code inside a Subroutine and then call that subroutine with VBRun, passing the values to it at the same time.

Here is a fictional subroutine that takes a parameter and we call it with the VBRun command, passing in the value:

VBSTART

Sub GetAllSubFolders(foldername)
MsgBox "You sent parm: " & foldername
End Sub

VBEND

VBRUN>GetAllSubFolders,d:\

We could equally pass in a variable:

Let>folder=L:\
VBRun>GetAllSubFolders,folder

So, if you want to "call" some VBScript code and pass a variable into it, put that VBScript code in a VBScript Subroutine (Sub/EndSub) with a parameter to take the variable.

If the script must RETURN a variable BACK to MacroScript then use a Function:

VBSTART
Function SomeFunc(parm)
SomeFunc = parm + 5
End Function
VBEND

VBEval>SomeFunc(3),result

Let>myval=10
VBEval>SomeFunc(%myval%),result

With VBEval you must embed numeric values with % symbols and strings with quotes and string variables with quotes and % symbols:

Let>MyString= Hello World
VBEval>Trim("%MyString%"),MyString

[kpassaur]

I was referring to the script at the very top of this post. I understand the basics of passing the varable with Macro Scheduler as I have used it in the past. However, with the vbscript at the top of this post you have the line

Sub GetAllSubFolders(foldername)

When I try to run it using VBRun and send a variable it will not work as later in the script it has the line

GetAllSubFolders "P:\"

I quess I should just stay with the dos method

[Marcus Tettmar]

No, it won't work as you expect because of the way that script is structured. If you look closely at it you will see that there is some vbscript code beneath the GetAllSubFolders subroutine which is not in a subroutine or function. It is this code that sets everything up and then calls GetAllSubFolders with the p:\ foldername. You are bypassing this code by calling GetAllSubFolders directly. The solution is to put the second block of code in a subroutine which you can call with the foldername of your choice.

This will work:


Let>VBS_TIMEOUT=20000
VBSTART

Sub GetAllSubFolders(foldername)
On Error Resume Next
Dim f, fc
Set f = fs.GetFolder(foldername)
Set fc = f.SubFolders
For Each f in fc
outf.WriteLine f.Path
GetAllSubFolders foldername & "\" & f.name
Next
End Sub

Sub DoGetAllSubs(foldername)
Dim fs, d, foldername
Set fs = CreateObject("Scripting.FileSystemObject")
Set outf = fs.OpenTextFile("C:\~PDrive~.txt", 2, True)

GetAllSubFolders foldername
outf.Close
Set fs = Nothing
Set outf = Nothing
MsgBox "All done"
End Sub
VBEND

VBRUN>DoGetAllSubs,L:\

So can you see how now I am calling the setup code which I have now put in the DoGetAllSubs subroutine. This sets up the output file and calls the recursive function GetAllSubFolders.

[kpassaur]

That makes sense, now I just have to figure out how come it does not work.

[Marcus Tettmar]

Hi,

Sorry, I didn't actually test it. I was concentrating on explaining how to pass the variable without ensuring the code itself worked. The mistake I made was that a couple of the variables created in the setup code need to be global so that the GetAllSubFolders subroutine could access them. When I put the setup code in the new DoGetAllSubs subroutine I should have moved the Dim statements for these variables outside to ensure they stayed global.

I have also improved this by making the output filename a parameter of the main subroutine so that it isn't hardcoded. I have also commented out the On Error Resume Next so that if an error occurs we will know about it rather than it just doing nothing. Feel free to uncoment this when you know it's working.

So here's the code that works!

VBSTART
Dim fs, outf

Sub GetAllSubFolders(foldername)
'On Error Resume Next
Dim f, fc
Set f = fs.GetFolder(foldername)
Set fc = f.SubFolders
For Each f in fc
outf.WriteLine f.Path
GetAllSubFolders foldername & "\" & f.name
Next
End Sub

Sub DoGetAllSubs(foldername,outfile)
Set fs = CreateObject("Scripting.FileSystemObject")
Set outf = fs.OpenTextFile(outfile, 2, True)

GetAllSubFolders foldername
outf.Close
Set fs = Nothing
Set outf = Nothing
MsgBox "All done"
End Sub
VBEND

VBRUN>DoGetAllSubs,L:\,c:\LDrive.txt

[kpassaur]

Works great, so I don't know why Macro Scheduler would need a command like this buit in. However, it would be nice.

Thank you for you help on this, it not only works but provided me with a good example of how to pass variables.

[Marcus Tettmar]

BTW - Is there any reason you want the list of subfolders in a text file? If you want to cycle through them in script you could set the VBScript to return a semicolon delimited list or an array.

E.g:

VBSTART
Dim fs, outList

Sub GetAllSubFolders(foldername)
'On Error Resume Next
Dim f, fc
Set f = fs.GetFolder(foldername)
Set fc = f.SubFolders
For Each f in fc
outList = outList & f.Path & ";"
GetAllSubFolders foldername & "\" & f.name
Next
End Sub

Function DoGetAllSubs(foldername)
Set fs = CreateObject("Scripting.FileSystemObject")
GetAllSubFolders foldername
DoGetAllSubs = Mid(outList,1,Len(outList)-1)
End Function
VBEND

VBEval>DoGetAllSubs("c:\temp"),list
Separate>list,;,files
If>files_count>0
Let>k=0
Repeat>k
Let>k=k+1
Let>this_file=files_%k%
Message>this_file
Until>k=files_count
Endif

[kpassaur]

That will work even better, I am not very good with vbscript and I could not have done it without your help.

I was thinking of how Macro Scheduler could be enhanced. It seems to me that there are a few vbscripts that perform some sort of function that are on this site. These would make the ideal new features when you think about it as they are searched for and used frequently. Like this one, I am not the first with this request and in past I did it in a very ackward manner with a dos command. I used the vbscript on the site to search for files that were created between a time frame (I had to modiy it a little). I used another one to tell how old a file was in seconds.

The point being, is that these vbscripts are used over and over again so when thinking of the future it makes sense to me to add these functions. I know there is a place for suggested enhancements on this site. But when I think of it I think the best way would be to see how many times a post was looked at and if it could be a build in function.

What I have found that has helped me with vbscript is this site
http://www.w3schools.com/vbscript/vbscript_examples.asp
What is neat about it is the examples that they show you can modify and run on the site and see the results.

Anyway,

Thanks

[Marcus Tettmar]

Yes, a GetDirList function has been requested a few times and is on the list for a future release:

http://www.mjtnet.com/bugtracker/bug.ph ... =90&pos=22