Can anybody give me any pointers on the below script I'm trying to create please, basically I'm trying search for certain folders under a parent but the general child structure is roughly the same, if exists then copy certain extensions, but not all extensions exist in all the child folders
When I run the Script I'm not getting any files copied into the "harvest" folder or any child Folders created under the Harvest folder, both Folders and files all exist when Testing this script
Any Help Much appreciated
advancedPath = InputBox("Type the Application Sharepoint")
advancedDBPath = InputBox("Type the Database Folder")
harvestFolder = InputBox("Type the Harvest Folder")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set wshShell = WScript.CreateObject( "WScript.Shell" )
' Check if Harvest folder exist if not create
If Not objFSO.FolderExists(harvestFolder) Then
objFSO.CreateFolder(harvestFolder)
End If
'Extensions to copy
extStr = Array("*.ini", "*.pf","*.bat","*.admin","*.st","*.ver","*.propath")
If objFSO.FolderExists(advancedPath & "oalive80") Then
' Check if Oalive80 exist
If objFSO.FolderExists(advancedPath & "oalive80") = TRUE Then
objFSO.CreateFolder(harvestFolder & "oalive80")
objFSO.CopyFile advancedPath & "oalive80" & "\" & extStr, harvestFolder & "oalive80", false
objFSO.CopyFile advancedPath & "oalive80\oahfb10" & "\" & extStr, harvestFolder & "oalive80", false
End If
' Check if Oatest80 exist
If objFSO.FolderExists(advancedPath & "oatest80") = TRUE Then
objFSO.CreateFolder(harvestFolder & "oatest80")
objFSO.CopyFile advancedPath & "oatest80" & "\" & extStr, harvestFolder & "oatest80", false
End If
' Check if oplive exist
If objFSO.FolderExists(advancedPath & "oplive") = TRUE Then
objFSO.CreateFolder(harvestFolder " "oplive")
objFSO.CopyFile advancedPath & "oplive\gclib\pf" & "\" & extStr, harvestFolder & "oplive" false
End If
' Check if Live DB folder exist
If objFSO.FolderExists(advancedDBPath & "oalive80") = TRUE Then
objFSO.CreateFolder(harvestFolder & "LiveDB")
objFSO.CopyFile advancedDBPath & "oalive80\oa_data" & "\" & extStr, harvestFolder & "LiveDB", false
End If
End If
You should probably use a loop for the array, as shown below, for each of your copy code
For iCt = 0 To UBound(extStr)
strExtn = extStr(iCt)
objFSO.CopyFile advancedPath & "oalive80" & "\" & strExtn , harvestFolder & "oalive80", false
Next
Maybe use a function like shown below for your code:
Private Sub BulkCopyFile(ByVal objFSO As Scripting.FileSystemObject, ByVal strSourceFolder As String, ByVal strDestinationFolder As String)
extStr = Array("*.ini", "*.pf","*.bat","*.admin","*.st","*.ver","*.propath")
For iCt = 0 To UBound(extStr)
strExtn = extStr(iCt)
objFSO.CopyFile strSourceFolder & strExtn, strDestinationFolder, False
Next
End Sub
Example usage for your code
' Check if Oalive80 exist
If objFSO.FolderExists(advancedPath & "oalive80") = True Then
objFSO.CreateFolder (harvestFolder & "oalive80")
Call BulkCopyFile(objFSO, advancedPath & "oalive80" & "\", harvestFolder & "oalive80")
Call BulkCopyFile(objFSO, advancedPath & "oalive80\oahfb10" & "\", harvestFolder & "oalive80")
End If
Related
My script may be simplistically complex, but I am not seeing anything wrong with the code. For whatever reason, I can get every folder to copy instead of my Documents folder. My script says that the path is not found. When I tweak the code and Documents "path is found", I then get a "permissions denied" error. This problem has only been with the Documents folder. My code is below, I'm looking for help on how to resolve this one.
Option Explicit
Dim oShell, oFSO
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Const Overwrite = True
Dim strHomeFolder
Dim usersName
Dim UserProfile
strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
usersName = oShell.ExpandEnvironmentStrings("%USERNAME%")
Sub DataBackup
UserProfile = strHomeFolder & "\"
Dim Desktop, Documents, Downloads, Favorites, Pictures, Videos, Music,
Dim nDocuments, n1Documents
Documents = UserProfile & "Documents"
'nDocuments = "C:\Users\" + usersName + "\" + "Documents"+ "\" - " Test"
'n1Documents = "C:\Users\user.profile.name\Documents\" - "Test"
Desktop = UserProfile & "\Desktop"
Downloads = UserProfile & "\Downloads"
Favorites = UserProfile & "\Favorites"
Pictures = UserProfile & "\Pictures"
Videos = UserProfile & "\Videos"
Music = UserProfile & "\Music"
Dim dtmValue, strDate, strTime
dtmValue = Now()
'Assuming that you are creating these folders in C:\
strDate = "C:\MyBackup" & "_" & Month(dtmValue) & "-" & Day(dtmValue) & "-" & Year(dtmValue)
strTime = strDate & "_" & Hour(dtmValue) & "." & Minute(dtmValue)
Dim DestTimeStampFolder
DestTimeStampFolder = StrTime
oFSO.CreateFolder DestTimeStampFolder
MsgBox "check if folder exists!"
If Not oFSO.FolderExists(DestTimeStampFolder) Then
Set DestTimeStampFolder = oFSO.CreateFolder(DestTimeStampFolder)
End If
On Error Resume Next
MsgBox DestTimeStampFolder & "\Documents"
oFSO.CopyFolder Documents, DestTimeStampFolder & "\Documents", Overwrite
'oFSO.CopyFolder nDocuments, DestTimeStampFolder & "\Documents", Overwrite - ' "Used for Testing"
'oFSO.CopyFolder n1Documents, DestTimeStampFolder & "\Documents", Overwrite - ' "Used for Testing"
If Err Then
WScript.Echo "Error # " & Err.Number
WScript.Echo Err.Description
WScript.Quit 1
End If
End Sub
My debug code gives me an error code 70 (path not found) & 76 (permissions denied).
I want to create a vbscript that uses robocopy, which is fine, but I was hoping you can provide me the most elegant way to do this...
Copy all contents (Files and folders) of User Directory to this location EXCEPT copy AppData directory (Files and folders) to a different location AND copy Desktop directory to a different location
If FSO.folderExists(SOURCE & strAccount & "\AppData") Then
oShell.Run "robocopy " & appDataSource & " " & appDatastrDestination & appDatastrSwitches
Else
oShell.Run "robocopy " & strSource & " " & strDestination & strSwitches
End If
If you want to use all VBScript, you should be able to work with this. Edit - Added subs to reduce code.
On Error Resume Next
strSourceProfile = "C:\Users\NewUser"
strBaseFolder1 = "C:\Temp\"
strBaseFolder2 = "C:\Temp\Backup\"
strDestFolder1 = "C:\Temp\Backup\Profile\"
strDestFolder2 = "C:\Temp\Backup\Desk\"
strDestFolder3 = "C:\Temp\Backup\App\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const OverWriteFiles = True
' make sure target folders exist
ChkFolder strBaseFolder1
ChkFolder strBaseFolder2
ChkFolder strDestFolder1
ChkFolder strDestFolder2
ChkFolder strDestFolder3
For Each objFolder In objFSO.GetFolder(strSourceProfile).SubFolders
If objFolder.Name <> "Desktop" And objFolder.Name <> "AppData" Then
CopyToTarg objFolder.Path, strDestFolder1
End If
Next
For Each objFolder In objFSO.GetFolder(strSourceProfile).SubFolders
If objFolder.Name = "Desktop" Then
CopyToTarg objFolder.Path, strDestFolder2
End If
Next
For Each objFolder In objFSO.GetFolder(strSourceProfile).SubFolders
If objFolder.Name = "AppData" Then
CopyToTarg objFolder.Path, strDestFolder3
End If
Next
Sub ChkFolder(strFolder)
If Not(objFSO.FolderExists(strFolder)) Then
objFSO.CreateFolder(strFolder)
End If
End Sub
Sub CopyToTarg(strSource , strTarget)
objFSO.CopyFolder strSource , strTarget , OverWriteFiles
End Sub
I've never really written in vbs (once wrote a script that would welcome me on boot) but I'm after a script to essentially perform :
robocopy "folder1" "folder2" /MIR
At the moment what I've got is a copied script from here VBS Mirror, Using the top script :
This code synchronizes the contents (files and subfolders) of two
folders. Each folder is traversed recursively and any missing
subfolders and files are copied both ways. If corresponding folders
contain files with matching file names but with different time stamps,
the file with the newest time stamp will overwrite the older.
SyncFolders.vbs
Option Explicit
ForceScriptEngine("cscript")
Dim wshArgs
Set wshArgs = Wscript.Arguments
If WshArgs.Count = 2 Then
Call SyncFolders(WshArgs.Item(0), WshArgs.Item(1))
' Also run once in reverse to catch mismatching subfolder count:
Call SyncFolders(WshArgs.Item(1), WshArgs.Item(0))
Else
Wscript.Echo("Wrong number of arguments. Syntax: SyncFolders Folder1 Folder2")
Wscript.Sleep(3000) ' To allow Function syntax popup message to be seen.
End If
Sub SyncFolders(strFolder1, strFolder2)
Dim objFileSys
Dim objFolder1
Dim objFolder2
Dim objFile1
Dim objFile2
Dim objSubFolder
Dim arrFolders
Dim i
Set objFileSys = CreateObject("Scripting.FileSystemObject")
arrFolders = Array(strFolder1, strFolder2)
For i = 0 To 1 ' Make sure that missing folders are created first:
If objFileSys.FolderExists(arrFolders(i)) = False Then
wscript.echo("Creating folder " & arrFolders(i))
objFileSys.CreateFolder(arrFolders(i))
End If
Next
Set objFolder1 = objFileSys.GetFolder(strFolder1)
Set objFolder2 = objFileSys.GetFolder(strFolder2)
For i = 0 To 1
If i = 1 Then ' Reverse direction of file compare in second run
Set objFolder1 = objFileSys.GetFolder(strFolder2)
Set objFolder2 = objFileSys.GetFolder(strFolder1)
End If
For Each objFile1 in objFolder1.files
If Not objFileSys.FileExists(objFolder2 & "\" & objFile1.name) Then
Wscript.Echo("Copying " & objFolder1 & "\" & objFile1.name & _
" to " & objFolder2 & "\" & objFile1.name)
objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
objFolder2 & "\" & objFile1.name
Else
Set objFile2 = objFileSys.GetFile(objFolder2 & "\" & objFile1.name)
If objFile1.DateLastModified > objFile2.DateLastModified Then
Wscript.Echo("Overwriting " & objFolder2 & "\" & objFile1.name & _
" with " & objFolder1 & "\" & objFile1.name)
objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
objFolder2 & "\" & objFile1.name
End If
End If
Next
Next
For Each objSubFolder in objFolder1.subFolders
Call SyncFolders(strFolder1 & "\" & objSubFolder.name, strFolder2 & _
"\" & objSubFolder.name)
Next
Set objFileSys = Nothing
End Sub
Sub ForceScriptEngine(strScriptEng)
' Forces this script to be run under the desired scripting host.
' Valid arguments are "wscript" or "cscript".
' The command line arguments are passed on to the new call.
Dim arrArgs
Dim strArgs
For Each arrArgs In WScript.Arguments
strArgs = strArgs & " " & Chr(34) & arrArgs & Chr(34)
Next
If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
CreateObject("Wscript.Shell").Run "cscript.exe //Nologo " & _
Chr(34) & Wscript.ScriptFullName & Chr(34) & strArgs
Wscript.Quit
End If
Else
If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
CreateObject("Wscript.Shell").Run "wscript.exe " & Chr(34) & _
Wscript.ScriptFullName & Chr(34) & strArgs
Wscript.Quit
End If
End If
End Sub
I changed the :
Sub SyncFolders(strFolder1, strFolder2)
to
Sub SyncFolders(strC:\Users\Zac\Desktop\Folder, strW:\Folder)
and get the error "Expected ')'
I'm sure it's something very obvious, but could someone please tell me what I need to change in that script to make my folders mirror each other?
Since this vbscript force to deal with Cscript engine; you should execute it by a litlle batch like this way :
#echo off
Cscript /nologo SyncFolders.vbs "C:\Users\Zac\Desktop\Folder" "W:\Folder"
pause
Edit :
And if you like to avoid this batch and using Cscript engine,try this :
Option Explicit
'You must only change the absolute paths of the two folders here
Call SyncFolders("C:\Users\Zac\Desktop\Folder","W:\Folder")
'**********************Don't Change nothing below this line *****************************
Sub SyncFolders(strFolder1, strFolder2)
Dim objFileSys
Dim objFolder1
Dim objFolder2
Dim objFile1
Dim objFile2
Dim objSubFolder
Dim arrFolders
Dim i
Set objFileSys = CreateObject("Scripting.FileSystemObject")
arrFolders = Array(strFolder1, strFolder2)
For i = 0 To 1 ' Make sure that missing folders are created first:
If objFileSys.FolderExists(arrFolders(i)) = False Then
'wscript.echo("Creating folder " & arrFolders(i))
objFileSys.CreateFolder(arrFolders(i))
End If
Next
Set objFolder1 = objFileSys.GetFolder(strFolder1)
Set objFolder2 = objFileSys.GetFolder(strFolder2)
For i = 0 To 1
If i = 1 Then ' Reverse direction of file compare in second run
Set objFolder1 = objFileSys.GetFolder(strFolder2)
Set objFolder2 = objFileSys.GetFolder(strFolder1)
End If
For Each objFile1 in objFolder1.files
If Not objFileSys.FileExists(objFolder2 & "\" & objFile1.name) Then
'Wscript.Echo("Copying " & objFolder1 & "\" & objFile1.name & _
' " to " & objFolder2 & "\" & objFile1.name)
objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
objFolder2 & "\" & objFile1.name
Else
Set objFile2 = objFileSys.GetFile(objFolder2 & "\" & objFile1.name)
If objFile1.DateLastModified > objFile2.DateLastModified Then
'Wscript.Echo("Overwriting " & objFolder2 & "\" & objFile1.name & _
' " with " & objFolder1 & "\" & objFile1.name)
objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
objFolder2 & "\" & objFile1.name
End If
End If
Next
Next
For Each objSubFolder in objFolder1.subFolders
Call SyncFolders(strFolder1 & "\" & objSubFolder.name, strFolder2 & _
"\" & objSubFolder.name)
Next
Set objFileSys = Nothing
End Sub
'********************************************************************************
I used to use a line in Robocopy that would allow me to copy all folders in a folder INCLUDING the parent folder, I.E all files/folders in the Blackberry folder INCLUDING the Blackberry folder itself, else without it it would just copy the files within and dump them in the backup location...
The code used was;
for %%a in ("%source%") do SET destination="Backups\%date%\%%~nxa"
Now in VB Script I've got;
sSource = Chr(34) & objFolder.self.Path & Chr(34) & " "
So how would I go about having VB Script (which still calls Robocopy) use the above so that when it backs up it will include the PARENT folder as well?
This was the code I had; Converting Robocopy Batch To VB Script
Thanks in advance!
EDIT: The current content of my script file;
Dim BrowseBackupSource
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Please browse to the folder you would like to backup.", 1, "C:\")
If objFolder Is Nothing Then
Wscript.Quit
End If
wscript.Echo "folder: " & objFolder.title & " Path: " & objFolder.self.path
Dim BrowseBackupLocation
Set objShell = CreateObject("Shell.Application")
Set objDest = objShell.BrowseForFolder(0, "Please browse to the folder you would like to save the backup to.", 1, "C:\")
If objDest Is Nothing Then
Wscript.Quit
End If
wscript.Echo "folder: " & objDest.title & " Path: " & objDest.self.path
sCmd = "%windir%\System32\Robocopy.exe "
sDate = Day(Now) & "-" & Month(Now) & "-" & Year(Now)
sTime = Hour(Now) & "-" & Minute(Now) & "-" & Second(Now)
sSource = Chr(34) & objFolder.self.Path & Chr(34) & " "
sDestination = Chr(34) & objDest.self.Path & Chr(34) & " "
sSwitches = "/E /Log:"& sTime &".txt"
Set objShell = CreateObject("Wscript.Shell")
objShell.Run(sCmd & sSource & sDestination & sSwitches)
Well, if you need the path to the parent folder to set as root of copy:
dim parentFolderPath
parentFolderPath = WScript.CreateObject("Scripting.FileSystemObject").GetFolder(objFolder.self.Path).ParentFolder.Path
EDIT
You need the name of the selected source directory added to the path of the selected destination so
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
sSourceFolderName = fso.GetFolder(objFolder.self.Path).Name
sDestination = Chr(34) & objDest.self.Path & "\" & sSourceFolderName & Chr(34)
Robocopy will handle the target directory creation
If you want to create a copy of a particular folder for backup, why don't you simply copy that folder to the backup destination and be done with it?
Set fso = CreateObject("Scripting.FileSystemObject")
Set app = CreateObject("Shell.Application")
dst = "C:\backups\" & Year(Now) & "\" & Month(Now) & "\" & Day(Now)
CreatePath dst
Set fldr = app.BrowseForFolder(0, "Example", 1, "c:\Programs")
fso.CopyFolder fldr.Self.Path, dst & "\", True
Sub CreatePath(p)
If Not fso.FolderExists(p) Then
CreatePath fso.GetParentFolderName(p)
fso.CreateFolder p
End If
End Sub
I tried with this link
copy files between a specified date range
but i am able to copying only root directory
please any one help me
Here you go. Please note that this can potentially create empty directories because it will create a directory and then check to see if each file falls within the specified date range or not. If no files do, the directory will remain empty.
Obviously, you can comment out or delete the WScript.Echo lines. They are for troubleshooting only.
Option Explicit
dim objFSO, strSource, strTarget
set objFSO = CreateObject("Scripting.FileSystemObject")
strSource = "c:\Folder1\"
strTarget = "c:\Copy of Folder1\"
call RecurseCopy(strSource, strTarget, True, #04/15/2012 00:00:01 AM#, #04/16/2012 00:00:01 AM#)
' // Recursively copy all files and folders
Sub RecurseCopy(strSource, strTarget, blnCopySubfolders, dBeginDate, dEndDate)
dim objSource, objTarget
WScript.Echo "Begin RecurseCopy" & vbcrlf & vbcrlf & _
"strSource: " & strSource & vbcrlf & _
"strTarget: " & strTarget
set objSource = objFSO.GetFolder(strSource)
If objFSO.FolderExists(strTarget) = False Then
Wscript.Echo "Now going to create folder: " & strTarget
objFSO.CreateFolder(strTarget)
End If
set objTarget = objFSO.GetFolder(strTarget)
Dim file
for each file in objSource.files
If file.DateCreated => dBeginDate AND file.DateCreated =< dEndDate Then
Wscript.Echo "Copying file: " & file.path & " to " & objTarget.Path
file.Copy objTarget.Path & "\" & file.name
Else
WScript.Echo "File will not be copied because the DateCreated is not within the specified range." & vbcrlf & vbcrlf & _
File.Path & " " & file.DateCreated
End If
next
If blnCopySubfolders = True Then
' ** For each subfolder of current dir, copy files to target and recurse its subdirs
Dim subdir
for each subdir in objSource.subfolders
call RecurseCopy(objSource.Path & "\" & subdir.Name, objTarget.Path & "\" & subdir.Name, True, dBeginDate, dEndDate)
Next
End If
End Sub