cartelle modello scansiona tag nome file - vbs

' p

Option explicit

'

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

dim CurrentDirectory

CurrentDirectory = fso.GetAbsolutePathName(".")

'

dim cartelladascansionare, dbcartellaprocedura, esito

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

'cartelladascansionare = leggiparametri(dbcartellaprocedura & "cartella-da-scansionare.txt")

cartelladascansionare = dbcartellaprocedura

'

dim fileescluso

fileescluso = "ceram.jpg"

'

dim dblog, slog

dblog = dbcartellaprocedura & "note.txt"

'

slog = "tag: " & vbcrlf

call SovraScriviFile(dblog, slog)

'

Dim dizionario, chiave

Set dizionario = CreateObject("Scripting.Dictionary")

dizionario.CompareMode = vbTextCompare

'

call PrgElencaCartelletipo(cartelladascansionare, "jpg")

'

' srivi tag

'

dim a, i

a=dizionario.Keys

for i = 0 To dizionario.Count -1

slog = a(i)

if isnumeric(slog) = false then

call ScriviFileJollyAppend(dblog, slog)

end if

next

'

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

'

Sub PrgElencaCartelletipo(pFolder, ptipofile)

'

Dim fso, cartelle, percorsocartella, nomecartella, nomefile

dim SubFolder, File, tpath

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

if ucase(nomefile) = ucase(fileescluso) then

else

tpath = percorsocartella & nomefile

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

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

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

slog = "- " & nomefile & vbcrlf

call ScriviFileJollyAppend(dblog, slog)

' tag

call RicercaRisultato(nomefile, "\w+")

'

end if

End If

Next

'

'

End Sub

'

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

'

Function RicercaRisultato(strVal, comecercare) 'As String

Dim sParts, sPart, rPart 'As Object

Set rPart = CreateObject("VBScript.RegExp")

rPart.Global = True

rPart.IgnoreCase = True

rPart.pattern = comecercare '

'get the results

Set sParts = rPart.Execute(strVal)

'get the first match

For Each sPart In sParts

chiave = trim(spart)

If dizionario.Exists(chiave) = False Then

dizionario.Add chiave, chiave

else

End If

Next 'sPart

Set sParts = Nothing

End Function

'

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

'

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

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

' === fine ===

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