shadow copies script to create a VSS folder and populate it with links to shadow copy volumes

Option Explicit

Const strFp = "C:\vss\" ''destination folder to hold VSS links to copies

Sub EnumerateShadows()
   Dim strComputer
   Dim objWMIService
   Dim snapshot, snapshots
   Dim foldername, strcmd

   Dim sdate
   Dim vdate ''As String

   Dim fso 'As FileSystemObject
   Set fso = CreateObject("Scripting.FileSystemObject")
 
   Dim WSHShell 'As WSHShell
   Set WSHShell = CreateObject("WScript.Shell")
 
   On Error GoTo fubar:
   If Not fso.FolderExists(strFp) Then fso.CreateFolder strFp

      strComputer = "desk014"
      Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
      Set snapshots = objWMIService.ExecQuery("Select * from Win32_ShadowCopy")
      For Each snapshot In snapshots
         sdate = snapshot.InstallDate
         vdate = Left(sdate, 4) & "-" & Mid(sdate, 5, 2) & "-" & Mid(sdate, 7, 2) & "-" & Mid(sdate, 9, 2) & Mid(sdate, 11, 2)
       
         strcmd = "mklink /d " & strFp & vdate & " " & snapshot.DeviceObject & "\"
       
         WSHShell.Run "cmd.exe /C " & strcmd, 0, True
       
      Next

      MsgBox "Completed see " & strFp
      Exit Sub
fubar:
      MsgBox "error"
End Sub

Comments

Popular posts from this blog

Powerpoint countdown and current time in slides VBA

Revit area plans adding new types and references (Gross and rentable)