Di seguito il listato di un VBScript che fa le seguenti attività:
1.Mappatura Share di Rete
2.Copia dei file dalla cartella localle (Sorgente) alla share di rete (Destinazione)
3.Archiviazione (Spostamento) dei file copiati dalla cartella sorgente ad un’altra cartella
4.Check sui vari Step precedentemente descritti
5.Invio Mail inserendo all’interno del corpo del messaggio il percorso dei file copiati
I campi da modificare sono i seguenti:
Dim Cartella: Cartella = “S:\Applicativi\”
strRemotePath = “\\server\Scarico”
strUser = “User”
strPassword = “Password”
objMessage.Configuration.Fields.Item (“http://schemas.microsoft.com/cdo/configuration/smtpserver”) = “server SMTP”
Option Explicit
Main
Sub Main
Dim Cartella: Cartella = “S:\Applicativi\”
Dim Path: Path = Cartella & “*.*”
Dim Message: Message=””
Dim a: a = ListDir(Path)
If (UBound(a) = -1) then
WScript.Echo “No files found.”
Exit Sub
End If
Dim FileName
Dim objNetwork
Dim strDriveLetter, strRemotePath, strUser, strPassword, strProfile
‘ Values of variables set
strDriveLetter = “X:”
strRemotePath = “\\server\Scarico”
strUser = “User”
strPassword = “Password”
strProfile = “false”
‘Mappatura percorso di rete
Set objNetwork = WScript.CreateObject(“WScript.Network”)
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath, strProfile, strUser, strPassword
‘Ciclo sui file
Dim FSO: Set FSO =CreateObject(“scripting.FileSystemObject”)
For Each FileName In a
FSO.CopyFile FileName , Replace(FileName,Cartella,”X:\”), True
FSO.MoveFile FileName , Replace(FileName,Cartella,”S:\Applicativi\Test\”)
Message = Message + FileName + chr(13)
Next
‘Eliminazione mappatura del drive X
objNetwork.RemoveNetworkDrive strDriveLetter
if (Message<>””) then
Dim objMessage: Set objMessage = CreateObject(“CDO.Message”)
objMessage.Subject = “Copia Dati Test”
objMessage.From = “info@raffaelechiatto.com”
objMessage.To = “raffaele.chiatto@gmail.com”
objMessage.Cc = “raffaele2.chiatto@gmail.com;
objMessage.TextBody = “Copia effettuata con successo.” + chr(13) & Message
objMessage.Configuration.Fields.Item (“http://schemas.microsoft.com/cdo/configuration/sendusing”) = 2
objMessage.Configuration.Fields.Item (“http://schemas.microsoft.com/cdo/configuration/smtpserver”) = “server SMTP”
objMessage.Configuration.Fields.Item (“http://schemas.microsoft.com/cdo/configuration/smtpserverport”) = 25
objMessage.Configuration.Fields.Update
objMessage.Send
WScript.Echo “Mail inviata”
end if
End Sub
Public Function ListDir (ByVal Path)
Dim fso: Set fso = CreateObject(“Scripting.FileSystemObject”)
If Path = “” then Path = “*.*”
Dim Parent, Filter
if fso.FolderExists(Path) then ‘ Path is a directory
Parent = Path
Filter = “*”
Else
Parent = fso.GetParentFolderName(Path)
If Parent = “” Then If Right(Path,1) = “:” Then Parent = Path: Else Parent = “.”
Filter = fso.GetFileName(Path)
If Filter = “” Then Filter = “*”
End If
ReDim a(10)
Dim n: n = 0
Dim Folder: Set Folder = fso.GetFolder(Parent)
Dim Files: Set Files = Folder.Files
Dim File
For Each File In Files
If CompareFileName(File.Name,Filter) Then
If n > UBound(a) Then ReDim Preserve a(n*2)
a(n) = File.Path
n = n + 1
End If
Next
ReDim Preserve a(n-1)
ListDir = a
End Function
Private Function CompareFileName (ByVal Name, ByVal Filter) ‘ (recursive)
CompareFileName = False
Dim np, fp: np = 1: fp = 1
Do
If fp > Len(Filter) Then CompareFileName = np > len(name): Exit Function
If Mid(Filter,fp) = “.*” Then ‘ special case: “.*” at end of filter
If np > Len(Name) Then CompareFileName = True: Exit Function
End If
If Mid(Filter,fp) = “.” Then ‘ special case: “.” at end of filter
CompareFileName = np > Len(Name): Exit Function
End If
Dim fc: fc = Mid(Filter,fp,1): fp = fp + 1
Select Case fc
Case “*”
CompareFileName = CompareFileName2(name,np,filter,fp)
Exit Function
Case “?”
If np <= Len(Name) And Mid(Name,np,1) <> “.” Then np = np + 1
Case Else
If np > Len(Name) Then Exit Function
Dim nc: nc = Mid(Name,np,1): np = np + 1
If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
End Select
Loop
End Function
Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter, ByVal fp0)
Dim fp: fp = fp0
Dim fc2
Do ‘ skip over “*” and “?” characters in filter
If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
fc2 = Mid(Filter,fp,1): fp = fp + 1
If fc2 <> “*” And fc2 <> “?” Then Exit Do
Loop
If fc2 = “.” Then
If Mid(Filter,fp) = “*” Then ‘ special case: “.*” at end of filter
CompareFileName2 = True: Exit Function
End If
If fp > Len(Filter) Then ‘ special case: “.” at end of filter
CompareFileName2 = InStr(np0,Name,”.”) = 0: Exit Function
End If
End If
Dim np
For np = np0 To Len(Name)
Dim nc: nc = Mid(Name,np,1)
If StrComp(fc2,nc,vbTextCompare)=0 Then
If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
CompareFileName2 = True: Exit Function
End If
End If
Next
CompareFileName2 = False
End Function
Wscript.Quit
