vbscript - sposta di un cartella in base al tipo e al contenuto

'

option explicit

'

' vbscript

' nella cartella dove è collocato lo script scorre tutti i file.

' se il tipo file è diverso da .txt

' sposta i file in una sottocartella.

' Legge la prima riga del file .txt e se in questa non è presente

' una determinata parola li sposta in una sottocartella

'

dim archivio, archivioaltro

'

dim dovesono, sifile, nofile, testata

' legge il percorso di dove è collocato lo script.

dovesono = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName) & "\"

archivio = dovesono & "archivio\"   

archivioaltro = dovesono & "altro\"

'

dim parolachiave

parolachiave = "LISTINO"

'

call verificacartella(archivio)

call verificacartella(archivioaltro)

'

sifile = ""

nofile = ""

'

call elencafilecartella(dovesono, "txt")

'

'call ScriviFileJolly(dovesono & "file-corrispondenti.txt", sifile)

'call ScriviFileJolly(dovesono & "file-non-corrispondenti.txt", nofile)

'

' =============

'

sub verificacartella(pcartella)

dim fso, shl, exists

Set fso = CreateObject("Scripting.FileSystemObject")

Set shl = CreateObject("WScript.Shell")

'  

exists = fso.FolderExists(pcartella)

 

if (exists)  = false then

   fso.CreateFolder pcartella

end if

'

'

end sub

'

' =============

'

sub elencafilecartella(cartellainlettura, tipofile)

'

Dim file        ' il file

Dim folder     ' la directory corrente

Dim fso        ' file system object

dim suffisso

' Creo il FileSystemObject

Set fso=CreateObject("Scripting.FileSystemObject")

Set folder=fso.GetFolder(cartellainlettura)

'

' scorro tutti i file

For Each file in folder.Files

    suffisso = fso.GetExtensionName(file.Path)

    if ucase(suffisso) = ucase(tipofile) then

       sifile = sifile & file.name & vbcrlf

       call leggitestata(file.Path)

       if testata = parolachiave then

       else

          call MoveAFile(file.Path, archivioaltro)

       end if

    else

       if suffisso <> "vbs" then 

         'nofile = nofile & file.name & vbcrlf

          nofile = nofile & file.Path & vbcrlf

          call MoveAFile(file.Path, archivio)

       end if

    end if

Next

'

set fso = Nothing

'

end sub

'

' ==============

'

sub leggitestata(pfile)

dim fso, f, myline

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.OpenTextFile(pfile, 1)

myLine = f.ReadLine

testata = left(myline, 7)

f.close

end sub

'

' ============

'

Sub MoveAFile(pfile, pcartella)

'msgbox pfile & vbcrlf &  pcartella

Dim fso

Set fso = CreateObject("Scripting.FileSystemObject")

fso.MoveFile pfile, pcartella

End Sub

'

' ==== =======

'

Sub ScriviFileJolly(NomeArchivio, cosascrivere)

dim fso,  rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

Set rifefile = fso.CreateTextFile(NomeArchivio, TRUE)

rifefile.WriteLine(cosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

'

' ===

'

vbs -verifica se il programma di posta outlook si trova in esecuzione

'

option explicit

'

' vbs -verifica se il programma di posta outlook si trova in esecuzione

'

dim sprocesso, presente, trovato

dim sComputerName, objWMIService, sQuery, objItems, objItem

trovato = 0

'

sComputerName = "."

    Set objWMIService = GetObject("winmgmts:\\" & sComputerName & "\root\cimv2")

    sQuery = "SELECT * FROM Win32_Process"

    Set objItems = objWMIService.ExecQuery(sQuery)

    'iterate all item(s)

    For Each objItem In objItems

        sprocesso = objItem.Name

        presente = instr(lcase(sprocesso), "outlook.exe")

        if presente > 0 then

           trovato = 1

           exit for

        else

           trovato = 0 

        end if

    Next

'

if trovato = 0 then

   'msgbox "outlook NON attivo"

else

  ' msgbox "outlook attivo" 

end if