We help IT Professionals succeed at work.

Vbscript: copy files into a datestamp folder

Luis Diaz
Luis Diaz asked
on
Hello experts,

The following script allows me to copy folder from one folder to another:

' Text file I/O constants
Const cForReading = 1
Const cForWriting = 2
Const cForAppending = 8
Const cTristateTrue = -1
Const cTristateFalse = 0
Const cTristateUseDefault = -2

Dim errMsg , strFile , msg1 , strPath
Dim workingDir , strBaseDir , strLog1 , objLog
Dim arrFolders
Dim objFSO, objOrgDict

' Define variables, folders and files you want to work it
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrgDict = CreateObject("Scripting.Dictionary")
objOrgDict.CompareMode = vbTextCompare
workingDir = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
strLog = workingDir & "\log-copy.txt"
arrFolders = Array("Daily")
strBaseDir1 = "\\Server\Daily"
strBaseDir2 = workingDir


dtmStartTime = Timer * 100

' Define log variable
Set objLog = objFSO.OpenTextFile(strLog, cForAppending, True)

CopyArrayFolders arrFolders, strBaseDir1,strBaseDir2

dtmEndTime = Timer * 100
lngElaps = dtmEndTime - dtmStartTime
objLog.WriteLine Now & " INFO: " & WScript.ScriptName & " completed with elapsed time: " & FormatElapsedTime(lngElaps)
MsgBox WScript.ScriptName & " completed with elapsed time: " & FormatElapsedTime(lngElaps)

objLog.Close
WScript.Quit

'----------------------------------------------------------------------------
' Copy Files based on an Array
'----------------------------------------------------------------------------
Sub CopyArrayFolders(darrFolder, dInputDir, dOutputDir)

   For Each strFolder In darrFolder
       ' Build the full path
   	strPath = dInputDir & "\" & strFolder
   	If objFSO.FolderExists(strPath) Then
   	   objFSO.CopyFolder strPath, dOutputDir & "\"
   	   objLog.WriteLine Now & "==>""" & strFolder & """ has been copied from """ & dInputDir  & """ to """ & dOutputDir & """."
   	Else
         ' Doesn't exist, report this error
         objLog.WriteLine Now & "==> """ & strPath & """ does not exist."
      End If 
   Next

End Sub


Function FormatElapsedTime(intElaps)
  intSeconds = intElaps \ 100
  lngMilli = (intElaps Mod 100) / 100
  intHours = intSeconds \ 3600
  intSeconds = intSeconds Mod 3600
  intMinutes = intSeconds \ 60
  intSeconds = intSeconds Mod 60
  FormatElapsedTime = Right("0" & intHours, 2) & ":" & Right("0" & intMinutes, 2) & ":" & Right("0" & intSeconds + lngMilli, 5)
End Function

Open in new window


I would like to add the following improvement:

copy the various folders into a date stamp folder YYYYMMDD_HHMMSS located at strBaseDir2

If you have questions, please contact me.
Comment
Watch Question

KimputerIT Manager
CERTIFIED EXPERT

Commented:
function date_stamp()
 date_stamp = cstr(year(now)) +  leadingzero(month(now)) +  leadingzero(day(now)) + "_" +  leadingzero(hour(now)) +  leadingzero(minute(now)) +  leadingzero(second(now))
end function


function leadingzero(input)
	leadingzero = right("0" + cstr(input),2)
end function

Open in new window


add the date_stamp string to the output folder, e.g. objFSO.CopyFolder strPath, dOutputDir& "\" & date_stamp() & "\"
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
This should work, assuming that you wanted a new subfolder of strBaseDir2, and not just appending the date/time string onto it's name.

' Text file I/O constants
Const cForReading = 1
Const cForWriting = 2
Const cForAppending = 8
Const cTristateTrue = -1
Const cTristateFalse = 0
Const cTristateUseDefault = -2

Dim errMsg , strFile , msg1 , strPath
Dim workingDir , strBaseDir , strLog1 , objLog
Dim arrFolders
Dim objFSO, objOrgDict

' Define variables, folders and files you want to work it
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrgDict = CreateObject("Scripting.Dictionary")
objOrgDict.CompareMode = vbTextCompare
workingDir = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
strLog = workingDir & "\log-copy.txt"
arrFolders = Array("Daily")
strBaseDir1 = "\\Server\Daily"
strBaseDir2 = workingDir

dtmStartTime = Timer * 100

' Define log variable
Set objLog = objFSO.OpenTextFile(strLog, cForAppending, True)

CopyArrayFolders arrFolders, strBaseDir1, strBaseDir2 & "\" & TimeStamp(Now)

dtmEndTime = Timer * 100
lngElaps = dtmEndTime - dtmStartTime
objLog.WriteLine Now & " INFO: " & WScript.ScriptName & " completed with elapsed time: " & FormatElapsedTime(lngElaps)
MsgBox WScript.ScriptName & " completed with elapsed time: " & FormatElapsedTime(lngElaps)

objLog.Close
WScript.Quit

'----------------------------------------------------------------------------
' Copy Files based on an Array
'----------------------------------------------------------------------------
Sub CopyArrayFolders(darrFolder, dInputDir, dOutputDir)

   For Each strFolder In darrFolder
       ' Build the full path
   	strPath = dInputDir & "\" & strFolder
   	If objFSO.FolderExists(strPath) Then
   	   objFSO.CopyFolder strPath, dOutputDir & "\"
   	   objLog.WriteLine Now & "==>""" & strFolder & """ has been copied from """ & dInputDir  & """ to """ & dOutputDir & """."
   	Else
         ' Doesn't exist, report this error
         objLog.WriteLine Now & "==> """ & strPath & """ does not exist."
      End If 
   Next

End Sub


Function FormatElapsedTime(intElaps)
  intSeconds = intElaps \ 100
  lngMilli = (intElaps Mod 100) / 100
  intHours = intSeconds \ 3600
  intSeconds = intSeconds Mod 3600
  intMinutes = intSeconds \ 60
  intSeconds = intSeconds Mod 60
  FormatElapsedTime = Right("0" & intHours, 2) & ":" & Right("0" & intMinutes, 2) & ":" & Right("0" & intSeconds + lngMilli, 5)
End Function


Function TimeStamp(dtmDateTime)
    ' Build string of current date time (DDMMYYYY_HHMMSS)
    TimeStamp = Year(dtmDateTime) & Right("0" & Month(dtmDateTime), 2) & Right("0" & Day(dtmDateTime), 2) & "_" & Right("0" & Hour(dtmDateTime), 2) & Right("0" & Minute(dtmDateTime), 2) & Right("0" & Second(dtmDateTime), 2)
End Function

Open in new window


»bp
Luis DiazIT consultant

Author

Commented:
Thank you very much.

I will test it and keep you informed.
Luis DiazIT consultant

Author

Commented:
Hello Bill,

I tested your proposal but I got a path not found:

20191113_131451-screenshot.png
I tried to adjust like as reported bellow but I just got files reported in array variable copied to date stamp folder instead of having the folder reported in array to date stamp folder.
Thank you in advance for your help.

' Text file I/O constants
Const cForReading = 1
Const cForWriting = 2
Const cForAppending = 8
Const cTristateTrue = -1
Const cTristateFalse = 0
Const cTristateUseDefault = -2

Dim errMsg , strFile , msg1 , strPath
Dim workingDir , strBaseDir , strLog1 , objLog
Dim arrFolders
Dim objFSO, objOrgDict

' Define variables, folders and files you want to work it
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrgDict = CreateObject("Scripting.Dictionary")
objOrgDict.CompareMode = vbTextCompare
workingDir = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
strLog = workingDir & "\log-copy.txt"
arrFolders = Array("Daily")
' Folder in which are located folders reported in arrFolders
strBaseDir1 = "\\share\production\ADMIN\"
strBaseDir2 = workingDir

dtmStartTime = Timer * 100

' Define log variable
Set objLog = objFSO.OpenTextFile(strLog, cForAppending, True)

CopyArrayFolders arrFolders, strBaseDir1, strBaseDir2

dtmEndTime = Timer * 100
lngElaps = dtmEndTime - dtmStartTime
objLog.WriteLine Now & " INFO: " & WScript.ScriptName & " completed with elapsed time: " & FormatElapsedTime(lngElaps)
MsgBox WScript.ScriptName & " completed with elapsed time: " & FormatElapsedTime(lngElaps)

objLog.Close
WScript.Quit

'----------------------------------------------------------------------------
' Copy Files based on an Array
'----------------------------------------------------------------------------
Sub CopyArrayFolders(darrFolder, dInputDir, dOutputDir)

   For Each strFolder In darrFolder
       ' Build the full path
   strPath = dInputDir & "\" & strFolder
   If objFSO.FolderExists(strPath) Then
      objFSO.CopyFolder strPath, dOutputDir &"\" & TimeStamp(Now)
     objLog.WriteLine Now & "==>""" & strFolder & """ has been copied from """ & dInputDir  & """ to """ & dOutputDir & "\" & TimeStamp(Now)& """."
   Else
         ' Doesn't exist, report this error
         objLog.WriteLine Now & "==> """ & strPath & """ does not exist."
      End If 
   Next

End Sub


Function FormatElapsedTime(intElaps)
  intSeconds = intElaps \ 100
  lngMilli = (intElaps Mod 100) / 100
  intHours = intSeconds \ 3600
  intSeconds = intSeconds Mod 3600
  intMinutes = intSeconds \ 60
  intSeconds = intSeconds Mod 60
  FormatElapsedTime = Right("0" & intHours, 2) & ":" & Right("0" & intMinutes, 2) & ":" & Right("0" & intSeconds + lngMilli, 5)
End Function


Function TimeStamp(dtmDateTime)
    ' Build string of current date time (DDMMYYYY_HHMMSS)
    TimeStamp = Year(dtmDateTime) & Right("0" & Month(dtmDateTime), 2) & Right("0" & Day(dtmDateTime), 2) & "_" & Right("0" & Hour(dtmDateTime), 2) & Right("0" & Minute(dtmDateTime), 2) & Right("0" & Second(dtmDateTime), 2)
End Function

Open in new window

Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Try this.

' Text file I/O constants
Const cForReading = 1
Const cForWriting = 2
Const cForAppending = 8
Const cTristateTrue = -1
Const cTristateFalse = 0
Const cTristateUseDefault = -2

Dim errMsg , strFile , msg1 , strPath
Dim workingDir , strBaseDir , strLog1 , objLog
Dim arrFolders
Dim objFSO, objOrgDict

' Define variables, folders and files you want to work it
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrgDict = CreateObject("Scripting.Dictionary")
objOrgDict.CompareMode = vbTextCompare
workingDir = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
strLog = workingDir & "\log-copy.txt"
arrFolders = Array("Daily")
strBaseDir1 = "\\Server\Daily"
strBaseDir2 = workingDir

dtmStartTime = Timer * 100

' Define log variable
Set objLog = objFSO.OpenTextFile(strLog, cForAppending, True)

CopyArrayFolders arrFolders, strBaseDir1, strBaseDir2 & "\" & TimeStamp(Now)

dtmEndTime = Timer * 100
lngElaps = dtmEndTime - dtmStartTime
objLog.WriteLine Now & " INFO: " & WScript.ScriptName & " completed with elapsed time: " & FormatElapsedTime(lngElaps)
MsgBox WScript.ScriptName & " completed with elapsed time: " & FormatElapsedTime(lngElaps)

objLog.Close
WScript.Quit

'----------------------------------------------------------------------------
' Copy Files based on an Array
'----------------------------------------------------------------------------
Sub CopyArrayFolders(darrFolder, dInputDir, dOutputDir)

   For Each strFolder In darrFolder
       ' Build the full path
   	strPath = dInputDir & "\" & strFolder
   	If objFSO.FolderExists(strPath) Then
   	   objFSO.CopyFolder strPath, dOutputDir
   	   objLog.WriteLine Now & "==>""" & strFolder & """ has been copied from """ & dInputDir  & """ to """ & dOutputDir & """."
   	Else
         ' Doesn't exist, report this error
         objLog.WriteLine Now & "==> """ & strPath & """ does not exist."
      End If 
   Next

End Sub


Function FormatElapsedTime(intElaps)
  intSeconds = intElaps \ 100
  lngMilli = (intElaps Mod 100) / 100
  intHours = intSeconds \ 3600
  intSeconds = intSeconds Mod 3600
  intMinutes = intSeconds \ 60
  intSeconds = intSeconds Mod 60
  FormatElapsedTime = Right("0" & intHours, 2) & ":" & Right("0" & intMinutes, 2) & ":" & Right("0" & intSeconds + lngMilli, 5)
End Function


Function TimeStamp(dtmDateTime)
    ' Build string of current date time (DDMMYYYY_HHMMSS)
    TimeStamp = Year(dtmDateTime) & Right("0" & Month(dtmDateTime), 2) & Right("0" & Day(dtmDateTime), 2) & "_" & Right("0" & Hour(dtmDateTime), 2) & Right("0" & Minute(dtmDateTime), 2) & Right("0" & Second(dtmDateTime), 2)
End Function

Open in new window


»bp
Luis DiazIT consultant

Author

Commented:
Thank you Bill.

Tested again but I got just files of folder reported in array copied to date stamp folder instead of having the folder.

Thank you in advance for your help.
Test your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016
Commented:
Give this a try, although based on the documentation it seemed like the prior attempt should have worked.

' Text file I/O constants
Const cForReading = 1
Const cForWriting = 2
Const cForAppending = 8
Const cTristateTrue = -1
Const cTristateFalse = 0
Const cTristateUseDefault = -2

Dim errMsg , strFile , msg1 , strPath
Dim workingDir , strBaseDir , strLog1 , objLog
Dim arrFolders
Dim objFSO, objOrgDict

' Define variables, folders and files you want to work it
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrgDict = CreateObject("Scripting.Dictionary")
objOrgDict.CompareMode = vbTextCompare
workingDir = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
strLog = workingDir & "\log-copy.txt"
arrFolders = Array("Daily")
strBaseDir1 = "\\Server\Daily"
strBaseDir2 = workingDir

dtmStartTime = Timer * 100

' Define log variable
Set objLog = objFSO.OpenTextFile(strLog, cForAppending, True)

CopyArrayFolders arrFolders, strBaseDir1, strBaseDir2 & "\" & TimeStamp(Now)

dtmEndTime = Timer * 100
lngElaps = dtmEndTime - dtmStartTime
objLog.WriteLine Now & " INFO: " & WScript.ScriptName & " completed with elapsed time: " & FormatElapsedTime(lngElaps)
MsgBox WScript.ScriptName & " completed with elapsed time: " & FormatElapsedTime(lngElaps)

objLog.Close
WScript.Quit

'----------------------------------------------------------------------------
' Copy Files based on an Array
'----------------------------------------------------------------------------
Sub CopyArrayFolders(darrFolder, dInputDir, dOutputDir)

    If Not objFSO.FolderExists(dOutputDir) Then
        objFSO.CreateFolder dOutputDir
    End If

   For Each strFolder In darrFolder
       ' Build the full path
   	strPath = dInputDir & "\" & strFolder
   	If objFSO.FolderExists(strPath) Then
   	   objFSO.CopyFolder strPath, dOutputDir & "\"
   	   objLog.WriteLine Now & "==>""" & strFolder & """ has been copied from """ & dInputDir  & """ to """ & dOutputDir & """."
   	Else
         ' Doesn't exist, report this error
         objLog.WriteLine Now & "==> """ & strPath & """ does not exist."
      End If 
   Next

End Sub


Function FormatElapsedTime(intElaps)
  intSeconds = intElaps \ 100
  lngMilli = (intElaps Mod 100) / 100
  intHours = intSeconds \ 3600
  intSeconds = intSeconds Mod 3600
  intMinutes = intSeconds \ 60
  intSeconds = intSeconds Mod 60
  FormatElapsedTime = Right("0" & intHours, 2) & ":" & Right("0" & intMinutes, 2) & ":" & Right("0" & intSeconds + lngMilli, 5)
End Function


Function TimeStamp(dtmDateTime)
    ' Build string of current date time (DDMMYYYY_HHMMSS)
    TimeStamp = Year(dtmDateTime) & Right("0" & Month(dtmDateTime), 2) & Right("0" & Day(dtmDateTime), 2) & "_" & Right("0" & Hour(dtmDateTime), 2) & Right("0" & Minute(dtmDateTime), 2) & Right("0" & Second(dtmDateTime), 2)
End Function

Open in new window


»bp
Luis DiazIT consultant

Author

Commented:
Tested and it works! It seems that the outputdir should be created from the very beginning.
Just one remark, if I want to set up a variable to have a root folder which will contain the datestamp folder how should I proceed:

CopyArrayFolders arrFolders, strBaseDir1, strBaseDir2 & "Output" &  "\" & TimeStamp(Now)

But I supposed that the following should be created from the very beginning ?
strBaseDir2 & "Output" &  "\" & TimeStamp(Now)
Or we can try to define an strRootName = "Output"
If strRootName = "",  it will not create the folder and datestamp folder will  contains the folder as is. Else it will create the folder starting with strRootName.

Thank you in advance for your help.
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Sorry Luis, I don't understand what you are now asking.


»bp
Luis DiazIT consultant

Author

Commented:
Bill,
Currently the script copy into working dir => datestamp folder, folders reported in array.
I was wondering how to define a variable to have the choice to:
=>A is copy into workingdir => datestamp
=>Copy into workingdir => NewSubfolderName" (defined as variable) => datestamp.

Thank you for your help.
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Would you just use the strBaseDir2 variable, and change it from:

strBaseDir2 = workingDir

to say:

strBaseDir2 = workingDir & "\NewSubfolderName"


»bp
Luis DiazIT consultant

Author

Commented:
Noted, I tested and I was able to perform final action.
I should add the following to make it work.

' Create output folder if it doesn't exist
    If Not objFSO.FolderExists(strBaseDir2) Then
        objFSO.CreateFolder strBaseDir2
        objLog.WriteLine Now & "==>""" & strBaseDir2 & """ has been created"
    End If

Open in new window