Avant toute chose

Le code qui suit annule et remplace la procédure ChargerImages de l'article Alimenter une banque d'images automatiquement. Vous aurez besoin de tout le reste de l'article original pour que les choses fonctionnent correctement. Du coup, pensez à le consulter pour tout le reste de la mise en œuvre.

Si vous comparez les 2 portions de code, vous verrez que l'essentiel se joue au niveau du FindFirst qui cherche dans la table si une combinaison Image/Dossier de même nom existe déjà. Si c'est le cas, NoMatch prend la valeur False, et on se contente de décompter un doublon et de passer. Dans le cas où NoMatch vaut True, aucune correspondance n'a été trouvée, on peut donc ajouter l'image dans la table.

Et je voudrais bien savoir qui, chez Microsoft, a décidé de formuler le NoMatch de façon négative, ce qui ne simplifie pas la lecture du code... et mes explications ! ;-)

Le code VBA

' ---
' CHARGER TOUTES LES IMAGES D'UN DOSSIER DANS LA BASE
' ---
' Entrée : strDossier   <- Nom du dossier à parcourir.
'          strExtension <- Extension des fichiers images.
'
Sub ChargerImages( _
  ByVal strDossier As String, _
  Optional ByVal strExtension As String = "*.jpg")
 
  Dim rst As DAO.Recordset
  Dim strFichier As String
  Dim intImages As Integer
  Dim intDoublons As Integer
 
  ' Ajouter un \ à la fin du dossier, si nécessaire
  strDossier = AddBackslash(strDossier)
 
  ' Ouvrir la table
  Set rst = CurrentDb.OpenRecordset("tblImages", dbOpenDynaset)
 
  ' Lecture des images du dossier
  intImages = 0
  intDoublons = 0
  strFichier = Dir(strDossier & strExtension, vbNormal)
  While strFichier <> ""
    ' Vérifier que l'image n'a pas déjà été référencée
    rst.FindFirst "[Nom Fichier] = '" & Replace(strFichier, "'", "''") _
      & "' AND [Dossier] = '" & Replace(strDossier, "'", "''") & "'"
     
    If rst.NoMatch Then
      ' Ajouter l'image dans la table
      rst.AddNew
      rst("Nom Image") = FilenameWithoutExt(strFichier)
      rst("Nom Fichier") = strFichier
      rst("Dossier") = strDossier
      rst.Update
      intImages = intImages + 1
    Else
      ' L'image existe déjà, on décompte un doublon
      intDoublons = intDoublons + 1
    End If
   
    ' On passe au fichier suivant
    strFichier = Dir
  Wend
 
  ' On ferme !
  rst.Close
  Set rst = Nothing
  MsgBox "Opération terminée !" _
    & vbCrLf & intImages & " image(s) ajoutée(s)" _
    & vbCrLf & intDoublons & " doublon(s) ignoré(s)", _
    vbInformation
End Sub