Function verifica_link_immagini()
'Routine che permette di verificare se le immagini a cui si fa riferimento in
'in una tabella di Access sono realmente presenti in una data cartella del PC.
'La routine scrive vero o falso in un campo "flag_immagine" della stessa tabella.
'Scrive inoltre i nomi delle immagini in eccesso nel campo "immagine" di una tabella errori.
'Se ci sono pių di 10000 files nella cartella aumentare le array.
'variabili
Dim i As Integer, Cartella As String, immagine As String, Tabella As String
Dim miodb As Database, mioset As Recordset, trovato As String, immagini(10000)
Dim fs, f, f1, fc, s(10000), t As Long, r As Long, v(10000), n_rec As Long, p As Long, z As Long
Dim tab_errori As Recordset, TabErrori As String
'impostazioni di base
Cartella = "C:\images" 'cartella completa di percorso in cui cercare
Tabella = "products" 'tabella di access in cui verificare i link alle immagini
TabErrori = "tab_errori" 'tabella in cui scrivere i nomi delle immagini in eccesso
'apertura recordset
Set miodb = CurrentDb
Set mioset = miodb.OpenRecordset(Tabella)
GoSub SubShowFileList
mioset.MoveFirst
'ciclo di verifica per immagini mancanti
With mioset
Do Until .EOF
immagine = !Image
GoSub verifica
.Edit
If trovato = "OK" Then !flag_immagine = True Else !flag_immagine = False
Debug.Print immagine & " " & trovato
.Update
.MoveNext
Loop
End With
'ciclo di verifica per immagini in eccesso
With mioset
.MoveFirst
Do Until .EOF
z = z + 1
v(z) = !Image
.MoveNext
Loop
.Close
End With
Set mioset = miodb.OpenRecordset(TabErrori)
With mioset
For p = 1 To t
For r = 1 To z
If s(p) = v(r) Then GoTo prossimo
Next r
Debug.Print s(p) & " č in eccesso"
.AddNew
!immagine = s(p)
.Update
prossimo:
Next p
.Close
End With
Exit Function
'sub di verifica immagini mancanti
verifica:
For r = 1 To t
If immagine = s(r) Then
trovato = "OK"
Return
Else
trovato = "No"
End If
Next
Return
'sub che crea un indice dei files della cartella
SubShowFileList:
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(Cartella)
Set fc = f.Files
For Each f1 In fc
t = t + 1
s(t) = s(t) & f1.name
Debug.Print s(t)
Next
Return
End Function
|