VB Script Question?

[Emily McFarlan]

Good Morning,

 

     I am still kind of a beginner in creating VB scripts, but I am trying to work on a script for copying over a folder to all users under C:\Users\%User Profile%\AppData\Roaming?  I tried to look online but really have not found anything relating for what I am trying to do.  Any idea what is a good source for this?  Thank you in advance :-)

 

 

[mcloum]

Something like 

dim filesys

set filesys=CreateObject("Scripting.FileSystemObject")

If filesys.FileExists("c:\sourcefolder\anyfile.txt") Then

filesys.CopyFile "c:\sourcefolder\anyfile.txt", "C:\Users\Default\AppData\Roaming"

[Emily McFarlan]

 

Something like 

dim filesys

set filesys=CreateObject("Scripting.FileSystemObject")

If filesys.FileExists("c:\sourcefolder\anyfile.txt") Then

filesys.CopyFile "c:\sourcefolder\anyfile.txt", "C:\Users\Default\AppData\Roaming"

This will only copy over to new users on that PC correct since it is coming over from the Default Profile when a new profile is being built when a user logs into the system?  I need it to go to current user profiles on that PC. 

 

[mcloum]

Correct. IF you want to copy to existing folders then you would need to enumerate the folders first then put them in a array to go through them one by one and copy the file. I have 2 scripts somewhere that does something similar but uses external txt files that are generated. I'll dig them out and try and hash something together.

[mcloum]

Try this:

'~~Comment~~.
'This script will copy a specified file to each subfolder of a specified root folder.
'~~Script~~.

' Detects the path the script was run from
myname = WScript.ScriptFullName	
mypath = Left(myname, InstrRev(myname, "\"))

' Used for logging purposes.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFailed = objFSO.CreateTextFile(mypath & "\Failed.txt")
Set objSuccess = objFSO.CreateTextFile(mypath & "\Success.txt")

' TXT file containing folder names
Set objFolders = objFSO.OpenTextFile(mypath & "\Folders.txt")

On Error Resume Next

Do While Not objFolders.AtEndOfLine
	
	FolderName = objFolders.ReadLine
	
	'If you have an error, write to the failed file and do not attempt to change the password
	  If Err Then
		HandleErr()
		Err.Clear
	  Else
			Set File = objFSO.GetFile("path and name of file to be copied goes here")
			File.copy ("C:\Users\" & FolderName & "\filename.txt")
			objSuccess.WriteLine FolderName & " was successful"
	  End If
Loop

'Close all open files

objFailed.close
objSuccess.close

'Present yourself a message so you'll know its finsihed
msgbox "Done, Read the failed and success text files for any errors"

Sub HandleErr()
	objFailed.WriteLine FolderName & " Failed, try copying manually. " & Err.Number
End Sub

You will need to create a 'Folders.txt' with the names of the folders under C:\Users\ each on a seperate line and save this in the same location as the vbs file. Also edit the name (and path) of the file you want to copy and the destination name and path in the code.

 

Hope this helps.

[jake1eye]

Here is a Demo Recursive Copy VBS script. The script start at a parent folder and then it will go threw every folder and all the sub folders in the parent directory. This script creates a text file that list how the copy command would be read by the script

Example

Searching Folder : JsEdit
Fso.CopyFile C:\Users\Gunsmokingman\AppData\Roaming\Adersoft\JsEdit\JsEdit.dat , SomeDrive:\SomeFolderName , True

Demo_Recursive_Copy.vbs

'-> Object For Runtime
 Dim Act :Set Act = CreateObject("Wscript.Shell")
 Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
'-> Path To Start The Recursive Querry
 Dim Loc :Loc = Act.ExpandEnvironmentStrings("%UserProfile%\AppData\Roaming")
'-> Misc Varibles For Run Time
 Dim Col, Obj
'-> Varibles For The Text File To List Contents
 Dim Ts, Txt :  Txt = Act.CurrentDirectory & "\ResultsList.txt"
'-> Create A Text File To List The Results
 Set Ts = Fso.CreateTextFile(Txt)
  Ts.WriteLine "Start Time : " & Time() & vbCrLf & "Start Date : " & Time() & vbCrLf 
  Ts.WriteLine "Searching Folder : " & Fso.GetFolder(Loc).Name  
'-> Start Folder Recursive
  Recursive(Fso.GetFolder(Loc))
'-> Recursive Loops Threw All Folders And Sub Folders
   Function Recursive(F)
    For Each Col In F.Files
'-> Code Here To Copy File
    Ts.WriteLine "Fso.CopyFile " & Col.Path & " , " & "SomeDrive:\SomeFolderName"& " , True" 
    Next
    Ts.WriteBlankLines 1
    For Each Obj In F.SubFolders
     Ts.WriteLine "Searching Folder : " & Obj.Name
     Recursive(Obj)
    Next
   End Function
'-> Close The Text File
  Ts.Close
'-> Open The Text File
  Act.Run(Txt),1,True 
'-> Ask To Keep Or Delete The Text File
  If MsgBox("Did you want to keep this text file : " & Fso.GetFile(Txt).Name & _
  vbCrLf & "Yes to Keep the text file, No to delete the text file",4132, _
  "Keep or Delete") = 7 Then Fso.DeleteFile(Txt),True 

Rename Demo_Recursive_Copy.vbs.txt to Demo_Recursive_Copy.vbs to make active.

Demo_Recursive_Copy.vbs.txt

[Emily McFarlan]

Great thank you, I will try this after awhile and update when I can :-)