sposta per nome file - vbs

'p

Option explicit

'

dim tipofile, suffisso

tipofile = "jpg"

suffisso = "." & tipofile

'

dim fso: set fso = CreateObject("Scripting.FileSystemObject")

dim CurrentDirectory

CurrentDirectory = fso.GetAbsolutePathName(".")

'

dim cartelladascansionare, dbcartellaprocedura, esito

dbcartellaprocedura = CurrentDirectory & "\" ' "C:\da-pub\"

cartelladascansionare = dbcartellaprocedura

'

dim dblog, slog, parolachiave

dblog = dbcartellaprocedura & "log-lavori.txt"

'

' parola presente nel nome file

parolachiave = inputbox("parola cercata", "parola cercata", " ")

'

dim cartelladestinazione

cartelladestinazione = dbcartellaprocedura & parolachiave & "\"

msgbox ReportFolderStatus(cartelladestinazione)

'

call PrgElencaCartelletipo(cartelladascansionare, tipofile)

'

Function ReportFolderStatus(cartelladestinazione)

Dim fso, msg, f

Set fso = CreateObject("Scripting.FileSystemObject")

If (fso.FolderExists(cartelladestinazione)) Then

msg = cartelladestinazione & " exists."

Else

msg = cartelladestinazione & " doesn't exist."

Set f = fso.CreateFolder(cartelladestinazione)

End If

ReportFolderStatus = msg

End Function

'

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

'

Sub PrgElencaCartelletipo(pFolder, ptipofile)

'

Dim fso, cartelle, percorsocartella, nomecartella, nomefile

dim SubFolder, File, tpath, presente

Set fso = CreateObject("Scripting.FileSystemObject")

set Cartelle = fso.GetFolder(pFolder)

'

For Each File In fso.GetFolder(pFolder).Files

If UCASE(fso.GetExtensionName(File.Name)) = UCASE(ptipofile) Then

nomefile = File.Name

tpath = percorsocartella & nomefile

presente = instr(ucase(nomefile), ucase(parolachiave))

if presente > 0 then

' slog = "File.Name: " & File.Name & vbcrlf & tpath

nomefile = replace(nomefile, "-", " ")

nomefile = replace(nomefile, suffisso , ".")

slog = "- " & nomefile & vbcrlf

call ScriviFileJollyAppend(dblog, slog)

'

fso.MoveFile tpath, cartelladestinazione

end if

'

End If

Next

'

'

End Sub

'

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

'

function leggiparametri(sFilePathAndName)

dim sFileContents, oFS, oTextStream

Set oFS = CreateObject("Scripting.FileSystemObject")

If oFS.FileExists(sFilePathAndName) = True Then

Set oTextStream = oFS.OpenTextFile(sFilePathAndName,1)

sFileContents = trim(oTextStream.ReadAll)

oTextStream.Close

Set oTextStream = nothing

else

esito = esito + 1

End if

Set oFS = nothing

leggiparametri = sFileContents

'

if len(sFileContents) = 0 then

esito = esito + 1

end if

'

end function

'

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

'

Sub ScriviFileJollyAppend(pNomeArchivio, pcosascrivere)

dim fso, rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

If (fso.FileExists(pNomeArchivio)) Then

'msg = filespec & " esiste."

Set rifefile = fso.OpenTextFile(pNomeArchivio, 8)

Else

'msg = filespec & " Non esiste."

Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

End If

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

'

' === sovra scrive file ===================

'

Sub SovraScriviFile(pNomeArchivio, pcosascrivere)

dim fso, rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

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

' ===

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