h199
Legacy Member
Hallo
Ik heb een probleem in een backup script dat ik aan het maken ben.
De bedoeling van dit script is een aantal verschillende mappen te copieren naar een andere mappen structuur op een bepaalde drive en dit een maal per dag.
Het script zoals het nu is werkt maar geeft op het einde een foutmelding.
Volgends de foutmelding is er een probleem met deze regel :
"set thisfolder = fso.GetFolder(Src)" in de sub : copyme
Ziet er iemand wat het probleem is ? ik vind de fout niet.
Bedankt
Hieronder het volledige script met aangepaste source en destination folders.
Alles (ook submappen) in de map C:\test zal gecopieerd worden naar c:\<datum>\
Ik heb een probleem in een backup script dat ik aan het maken ben.
De bedoeling van dit script is een aantal verschillende mappen te copieren naar een andere mappen structuur op een bepaalde drive en dit een maal per dag.
Het script zoals het nu is werkt maar geeft op het einde een foutmelding.
Volgends de foutmelding is er een probleem met deze regel :
"set thisfolder = fso.GetFolder(Src)" in de sub : copyme
Ziet er iemand wat het probleem is ? ik vind de fout niet.
Bedankt
Hieronder het volledige script met aangepaste source en destination folders.
Alles (ook submappen) in de map C:\test zal gecopieerd worden naar c:\<datum>\
Code:
Option Explicit
'Bron
Dim SourceFolders(1)
SourceFolders(0) = "C:\test"
'Destinatie
Dim DestinationFolders(1)
DestinationFolders(0) = ""
'Constanten
Const DestDrv = "C:\"
Dim fso
Dim DestDrvObj, DestDrvFreespc, DestDrvFreespcAfter
Dim DestDirectory, objFolder
Dim Logg, logName
Dim indx1
Set fso = CreateObject("Scripting.FileSystemObject")
Set DestDrvObj = fso.GetDrive(DestDrv)
DestDirectory = DestDrv & FolderName(Date())
If fso.FolderExists(DestDirectory) Then
WScript.quit
Else
Set objFolder = fso.CreateFolder(DestDirectory)
End If
For indx1 = 0 to UBound(SourceFolders, 1)
copyme SourceFolders(indx1), DestDirectory & DestinationFolders(indx1)
Next
'wscript.echo
Set objFolder = Nothing
Set DestDrvObj = Nothing
Set fso = Nothing
wscript.quit
'<-------------------------------------------------------------------->
' Procedure voor het eigenlijke copieren
Sub copyme(Src, Dest)
Dim thisfolder, item, Spath, Dpath
set thisfolder = fso.GetFolder(Src)
If Not fso.FolderExists(Dest & "\" & thisfolder.Name) then fso.CreateFolder(Dest & "\" & thisfolder.Name)
For each item in thisfolder.Files
Spath = fso.BuildPath(Src, item.name)
' On error resume next
fso.CopyFile Spath, Dest & "\" & thisfolder.Name & "\" & item.Name
If Err.Number <> 0 then Wscript.echo "Error: " & Err.Number & " on " & Spath
on Error Goto 0
Next
For each item in thisfolder.SubFolders
Dpath = fso.BuildPath(Dest, thisfolder.Name)
copyme item.Path, Dpath
Next
Set thisfolder=Nothing
End Sub
'<-------------------------------------------------------------------->
'Functie die elke dag een nieuwe map aanmaakt
function FolderName(curTime)
dim Day, Month, Year
if len(Datepart("d", curTime)) = 1 then
Day = "0" & Datepart("d", curTime)
else
Day = Datepart("d", curTime)
end if
Month = GetMonth(Datepart("m", curTime))
Year = Datepart("yyyy", curTime)
FolderName = Day & " " & Month & " " & Year
end function
'Funstie de maandnummer omzet in iets bruikbaar
function GetMonth(indmaand)
Dim maand
select case indmaand
case 1
maand ="Jan"
case 2
maand ="Feb"
case 3
maand ="Maa"
case 4
maand ="Apr"
case 5
maand ="Mei"
case 6
maand ="Jun"
case 7
maand ="Jul"
case 8
maand ="Aug"
case 9
maand ="Sep"
case 10
maand ="Oct"
case 11
maand ="Nov"
case 12
maand ="Dec"
end select
GetMonth = UCase(maand)
end function