Access renommer fichier d'un répertoire avec path connu

Private Sub CiblePhoto_Click()
'Numéroter image

Dim boite As FileDialog
Dim LeFichier As Variant: Dim compteur As Byte

Set boite = Application.FileDialog(msoFileDialogFilePicker)
boite.AllowMultiSelect = True
boite.Show
compteur = 1

For Each LeFichier In boite.SelectedItems
Name LeFichier As Replace("", "", "") & "" & compteur & ".png"
compteur = compteur + 1
Next LeFichier

Set boite = Nothing
Set LeFichier = Nothing

End Sub

Bonjour,

J'ai trouvé le souci restant c'est qu'il enregistre les fichiers dans le répertoire NOAffaire et pas dans le répertoire PHOTOS qui est dedans

Private Sub MAJPH2_Click()

'Numéroter image
Dim dossier As Object

Dim chemin As String

Dim fichier As Object
chemin = CurrentProject.PATH & "\" & Me.NOAffaire & "\PHOTOS\"

Set FSO = CreateObject("Scripting.FileSystemObject")

Set dossier = FSO.GetFolder(chemin)
compteur = 1

For Each fichier In dossier.Files

Name fichier As Replace("", "", "") & "" & compteur & ".jpg"compteur = compteur + 1

Next
Set dossier = Nothing

Set fichier = Nothing
End Sub

Bonjour,

Essayez :

Private Sub MAJPH2_Click()

Dim Fso As Object, Dossier As Object, Fichier As Object
Dim RepertoireSource As String, RepertoireCible As String
Dim Compteur As Integer

        RepertoireSource = CurrentProject.Path & "\" & Me.NOAffaire & "\"
        RepertoireCible = CurrentProject.Path & "\" & Me.NOAffaire & "\PHOTOS\"

       ' Essai sur Excel
       ' RepertoireSource = ActiveWorkbook.Path & "\"
       ' RepertoireCible = ActiveWorkbook.Path & "\PHOTOS\"

        Set Fso = CreateObject("Scripting.FileSystemObject")

        Set Dossier = Fso.GetFolder(RepertoireCible)
        Compteur = Dossier.Files.Count + 1
        Set Dossier = Fso.GetFolder(RepertoireSource)

        For Each Fichier In Dossier.Files

            Select Case LCase(Fso.GetExtensionName(Fichier))
                   Case "jpg", "png", "jpeg"
                         Fso.MoveFile Fichier, RepertoireCible & Format(Compteur, "000") & Fso.GetExtensionName(Fichier)
                         Compteur = Compteur + 1
            End Select

        Next

        Set Fso = Nothing: Set Dossier = Nothing: Set Fichier = Nothing

End Sub

Bonjour,

Merci pour votre aide, je viens de tester sur excel et aussi acces et ca ne fonctionne pas malheureusement

J'ai bien testé sur Excel avant de vous répondre. Que se passe-t-il lorsque vous utilisez le code sur Excel ?