jgoering
asked on
What is causing this script to not delete new folders?
This script runs correctly except that its waits till the next day before it will delete files in the FolderBackup directory. If those files are present, and its the same day then the script just stops. Not sure why?
I'd like to be able to run it multiple times a day and have it act the same way, but I dont see why it only deletes the folders when they are more than 1 day diffrent (date must be diffrent not really 24 hours).
I'd like to be able to run it multiple times a day and have it act the same way, but I dont see why it only deletes the folders when they are more than 1 day diffrent (date must be diffrent not really 24 hours).
'Generic Variables used in this script
On Error Resume Next
Dim fso, fl, flName, fldrError, Today, tMonth, tDay, thour, subject, msg, sender, recipients, wPath
Dim aPath, path, info, settings, admin, source, additionalRecipients, fList, bPath, flFolder1, flFolder2, flFolder3
'Global Settings
sender = "archive@skyline.com"
admin = "johngoering@skyline.com"
dPath = "\\backupserv1\Archive\SAP\DIY\"
sPath = "\\backupserv1\Archive\SAP\Solutions\"
'Getting todays date as YYYY-MM-DD-HH-MM
tMonth = Month(Now)
If (tMonth < 10) Then
tMonth = "0" & tMonth
End If
tDay = Day(Now)
If (tDay < 10) Then
tDay = "0" & tDay
End If
Today = Year(Now) & "-" & tMonth & "-" & tDay & "-" & Hour(now) & "-" & Minute(Now)
Set fso = CreateObject("Scripting.FileSystemObject")
'INI file with Archive location for ART, Design, PM and CAD
Set f = fso.OpenTextFile("SAPArchive.ini",1)
Do While f.AtEndOfStream <> True
info = f.ReadLine
settings = Split(info,";",-1,1)
source = settings(0)
path = settings(1)
If (UBound(settings) > 1) Then
additionalRecipients = settings(2)
Else
additionalRecipients = ""
End If
folderMove source, path, additionalRecipients
Loop
'Folder Move
Sub folderMove(source, path, additionalRecipients)
If Not(additionalRecipients = "") Then
recipients = admin & "," & additionalRecipients
Else
recipients = admin
End If
Err.Clear
Set workingFolder = fso.GetFolder(path)
Set workingFC = workingFolder.SubFolders
If fso.FolderExists(path & "FolderBackup") Then
fso.DeleteFolder path & "FolderBackup", true
End If
If Not(Err.Number = 0) Then
subject = "SAP " & source & " Backup Folder Deletion Failed"
msg = "Folder Deletion Failed: " & Err.Number & " : " & Err.Description
sendMail sender, recipients, subject, msg
Err.Clear
End If
fso.CreateFolder path & "FolderBackup"
fso.CreateFolder path & "FolderBackup\" & Today
bPath = path & "FolderBackup\" & Today & "\"
msg = ""
subject = ""
For each fl in workingFC
flName = fl.name
If Not(flName = "Logs") AND Not(flName = "FolderBackup") Then
nameOk = True
For i = 1 to Len(flName)
If Asc(Mid(flName, i, 1)) = 63 Then
nameOk = False
End If
Next
If nameOk = True Then
fList = flName & vbNewLine
'Log folder to be moved
LogList fList, source, path
'Split Folder into seperate options for determining location.
flOptions = Split(flName,"-",-1,1)
flType = UCase(flOptions(0))
If (flType = "D" Or flType = "S") And IsNumeric(flOptions(1)) And Len(flOptions(1)) = 10 Then
If flType = "D" Then
aPath = dPath
Else
aPath = sPath
End If
flFolder1 = Left(flOptions(1), 4)
flFolder2 = Right(Left(flOptions(1), 7), 3)
flFolder3 = Right(flOptions(1), 3)
'Check to see if the SAP Project Number grouping folder exists, create if not.
'Folders named nnnn(nnnn is the first 4 numbers of the numeric protion of the Project Number)
If Not(fso.FolderExists(aPath & flFolder1)) Then
AddNewFolders flFolder1, aPath
End If
'Create Project Second Level Folder based on next 3 numbers so folder path is nnnn/nnn
If Not(fso.FolderExists(aPath & flFolder1 & "\" & flFolder2)) Then
wPath = aPath & flFolder1 & "\"
AddNewFolders flFolder2, wPath
End If
'Check to see if the specific Project Number folder exists, create if not.
'Folder is named based on the last 3 digits of Project Number
If Not(fso.FolderExists(aPath & flFolder1 & "\" & flFolder2 & "\" & flFolder3)) Then
wPath = aPath & flFolder1 & "\" & flFolder2 & "\"
AddNewFolders flFolder3, wPath
End If
'Create Source subfolder as needed - ART, PM, DESIGN, CAD
If Not(fso.FolderExists(aPath & flFolder1 & "\" & flFolder2 & "\" & flFolder3 & "\" & source)) Then
AddNewSubFolder aPath & flFolder1 & "\" & flFolder2 & "\" & flFolder3, source
End If
Err.Clear
mvPath = aPath & flFolder1 & "\" & flFolder2 & "\" & flFolder3 & "\" & source & "\"
fso.CopyFolder fl, mvPath, True
'Verify Copy Completed, before Deleting Folder
If (Err.Number = 0 Or Err.Number = 424) Then
Err.Clear
fso.MoveFolder fl, bPath
'Verify Delete was succesful or log error.
If Not(Err.Number = 0) Then
msg = msg & "Folder: " & flName & ". Had Error during Move, Error Number: " & Err.Number & ", Error Description: " & Err.Description & vbNewLine & vbNewLine
FldrError = 1
Err.clear
End If
Else
'Log Errors during Copy
msg = msg & "Folder: " & flName & ". Had Error during Copy, Error Number: " & Err.Number & ", Error Description: " & Err.Description & vbNewLine & vbNewLine
FldrError = 1
Err.clear
End If
Else
msg = msg & "File Name Error: File Name is invalid. Verify project number is correct and Project Type is correct " & flName & vbNewLine & vbNewLine
fldrError = 1
End If
Else
msg = msg & "Folder name contains an invalid character: " & flName & vbNewLine & vbNewLine
fldrError = 1
End If
End If
Next
If fldrError = 1 Then
subject = "SAP " & source & " Archive Error Log"
sendMail sender, recipients, subject, msg
fldrError = 0
End If
Err.clear
End Sub
'
'Added source subfolder as needed
Sub AddNewSubFolder(path, subf)
fso.CreateFolder(path & "\" & subf)
End Sub
'Add new folder
Sub AddNewFolders(num, path)
Set ArchFolder = fso.GetFolder(path)
Dim fc
Set fc = ArchFolder.SubFolders
fc.Add(num)
End Sub
'Sub to write folder error log to a text file to each archive location
Sub LogFolderError(msg, source)
If (source = "CAD") Then
cPath = CADPath & "CAD Error Log -" & Today & ".txt"
ElseIf (source = "ART") Then
cPath = ARTPath & "Art Error Log -" & Today & ".txt"
ElseIf (source = "DESIGN") Then
cPath = DesignPath & "Design Error Log -" & Today & ".txt"
ElseIf (source = "PM") Then
cPath = PMPath & "PM Error Log -" & Today & ".txt"
End If
Set rdFile = fso.OpenTextFile(cPath, 8, True)
rdFile.Write msg
rdFile.Close
End Sub
'List Folders Moved
Sub LogList(list, source, path)
cPath = path & "Logs\" & source & " File List - " & Today & ".txt"
Set rdFile = fso.OpenTextFile(cPath, 8, True)
rdFile.Write list
rdFile.Close
End Sub
Function sendMail(sender, recipients, subject, msg)
Set Config = WScript.CreateObject("CDO.Configuration")
Set Message = WScript.CreateObject("CDO.Message")
Config.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Config.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.skyline.com"
Config.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
Config.Fields.Update
Message.Configuration = Config
Message.To = recipients
Message.From = sender
Message.Subject = subject
Message.TextBody = msg
Message.Send
End Function
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Grade "B" - was I bad?