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