Transfert de fichiers photos

Selon la l'image au format jpg reçu,

J'ai obtenu ceci en utilisant la procédure sur les Evifs

Date de modification : 08/04/08 07:58
Date de création : 08/04/08 07:58
Date d'accès : 08/04/08 07:58

Date du cliché : 22/02/08 21:10

Cette dernière est la "seule" qui ne semble pas se modifier
lors de copier-coller ou de déplacement. Cette information
n'est pas disponible avec une image émanant de l'application
Paint.exe. Ceci ne signifie pas qu'elle n'est pas disponible
si un logiciel de dessin plus avancé est utilisé ... (je ne sais pas).

Pour boucler la boucle sur la discussion d'hier, il aurait fallu
tester l'existence de la "Date du cliché" pour chacun des "photos"
au format jpg. Si elles existent pas de problème, sinon il faudrait
s'en remettre à DateLastModified pour FSO ou à FileDateTime
pour la bibliothèque VBA.

À sa face même, l'utilisation "DateCreated" de FSO est périlleuse
en ce sens qu'elle se modifie lors d'un copier-coller ou d'un
déplacement de fichier. !

Voilà !







"Daniel.C" <dZZZcolardelle@free.fr> a écrit dans le message de news:
ebW6doh9IHA.4484@TK2MSFTNGP04.phx.gbl...

Regarde dans la liste des références cochées dans ton fichier,
Est-ce possible que tu aies de cocher aussi la référence suivante :

"Microsoft Scripting RunTime"

Et qu'elle est située avant la bibliothèque :
"Microsoft Shell Controls and Automation"

Si oui, décoche
"Microsoft Scripting RunTime"
car il y a une mauvaise interprétation des objets
entre les 2 bibliothèques

Bonjour.
Bingo.
Merci.

Tu as dû louper mon message où je faisais effectivement remarquer que
la da

On 4 août, 14:25, "michdenis" <michde...@hotmail.com> wrote:

Selon la l'image au format jpg reçu,

J'ai obtenu ceci en utilisant la procédure sur les Evifs

Date de modification : 08/04/08 07:58
Date de création : 08/04/08 07:58
Date d'accès : 08/04/08 07:58

Date du cliché : 22/02/08 21:10

Cette dernière est la "seule" qui ne semble pas se modifier
lors de copier-coller ou de déplacement. Cette information
n'est pas disponible avec une image émanant de l'application
Paint.exe. Ceci ne signifie pas qu'elle n'est pas disponible
si un logiciel de dessin plus avancé est utilisé ... (je ne sais pas) .

Pour boucler la boucle sur la discussion d'hier, il aurait fallu
tester l'existence de la "Date du cliché" pour chacun des "photos"
au format jpg. Si elles existent pas de problème, sinon il faudrait
s'en remettre à DateLastModified pour FSO ou à FileDateTime
pour la bibliothèque VBA.

À sa face même, l'utilisation "DateCreated" de FSO est périlleuse
en ce sens qu'elle se modifie lors d'un copier-coller ou d'un
déplacement de fichier. !

Voilà !

"Daniel.C" <dZZZcolarde...@free.fr> a écrit dans le message de news:
ebW6doh9IHA.4...@TK2MSFTNGP04.phx.gbl...> Regarde dans la liste des réf érences cochées dans ton fichier,
> Est-ce possible que tu aies de cocher aussi la référence suivante :

> "Microsoft Scripting RunTime"

> Et qu'elle est située avant la bibliothèque :
> "Microsoft Shell Controls and Automation"

> Si oui, décoche
> "Microsoft Scripting RunTime"
> car il y a une mauvaise interprétation des objets
> entre les 2 bibliothèques

Bonjour.
Bingo.
Merci.

;-)

Tu as dû louper mon post de ce matin où je faisais remarquer qu'il est
en colonne Z
s'agissant du cliché
Contrairement à ce que j'avais indiqué préalablement qui est la date
du fichier.

Sinon le principe était quand même d'abord d'aller chercher ces Exifs,
il me semble!
Pour vraiment boucler :o) car elle commencent à friser, sans retour du
commanditaire d'ailleurs
(ce qu' évoqué aussi ce matin), il y a aussi des outils pour ça mê me
si le bricolage est amusant!

Salutations.

--
lSteph

On 4 août, 14:25, "michdenis" <michde...@hotmail.com> wrote:

Selon la l'image au format jpg reçu,

J'ai obtenu ceci en utilisant la procédure sur les Evifs

Date de modification : 08/04/08 07:58
Date de création : 08/04/08 07:58
Date d'accès : 08/04/08 07:58

Date du cliché : 22/02/08 21:10

Cette dernière est la "seule" qui ne semble pas se modifier
lors de copier-coller ou de déplacement. Cette information
n'est pas disponible avec une image émanant de l'application
Paint.exe. Ceci ne signifie pas qu'elle n'est pas disponible
si un logiciel de dessin plus avancé est utilisé ... (je ne sais pas) .

Pour boucler la boucle sur la discussion d'hier, il aurait fallu
tester l'existence de la "Date du cliché" pour chacun des "photos"
au format jpg. Si elles existent pas de problème, sinon il faudrait
s'en remettre à DateLastModified pour FSO ou à FileDateTime
pour la bibliothèque VBA.

À sa face même, l'utilisation "DateCreated" de FSO est périlleuse
en ce sens qu'elle se modifie lors d'un copier-coller ou d'un
déplacement de fichier. !

Voilà !

"Daniel.C" <dZZZcolarde...@free.fr> a écrit dans le message de news:
ebW6doh9IHA.4...@TK2MSFTNGP04.phx.gbl...> Regarde dans la liste des réf érences cochées dans ton fichier,
> Est-ce possible que tu aies de cocher aussi la référence suivante :

> "Microsoft Scripting RunTime"

> Et qu'elle est située avant la bibliothèque :
> "Microsoft Shell Controls and Automation"

> Si oui, décoche
> "Microsoft Scripting RunTime"
> car il y a une mauvaise interprétation des objets
> entre les 2 bibliothèques

Bonjour.
Bingo.
Merci.

Pour tenir compte de la ficelle, ta réponse se résume à ceci :
Et pour que la fonction roule, tu dois ajouter cette bibliothèque:

'Microsoft Shell Controls and Automation

'-----------------------------------------
Sub test()
Dim RépertoireSource As String
Dim File As String, X As String
Dim Vers As String

'**** à déterminer*****
'Où sont les images
RépertoireSource = "C:Exceltoday"

'Où seront créés les nouveaux répertoires
'dans lesquels seront les fichiers aboutiront.
Vers = "C:Exceltoday"
'****************************

'Attribution du premier fichier à traiter
File = Dir(RépertoireSource & "*.jpg")

'boucle sur tous les fichiers images du
'répertoire source
Do While File <> ""
'Extraire la date de créaition du fichier
X = Format(Date_Du_Cliché(RépertoireSource, File), "dd-MM-YYYY")
'création du fichier X si absent
Shell Environ("comspec") & " /c mkdir " & Vers & X & "", 0
'Déplacement du fichier répertoire source
'vers nouveau répertoire
Shell Environ("comspec") & _
" /c Move " & RépertoireSource & """" & File & """" & _
" " & Vers & X, 0
'Traitement du nouveau fichier
File = Dir
Loop

End Sub
'-----------------------------------------

Function Date_Du_Cliché(chemin As String, _
Fichier As String) As Date
'Microsoft Shell Controls and Automation
Dim MyShell As New Shell, X As Date
Dim Dossier As Shell32.Folder
Dim MyFile As ShellFolderItem
Set Dossier = MyShell.Namespace(chemin)
Set MyFile = Dossier.Items.Item(Fichier)
On Error Resume Next
X = Dossier.GetDetailsOf(MyFile, 25)
If Err <> 0 Then Err.Clear: X = VBA.FileDateTime(chemin & Fichier)
Date_Du_Cliché = X
End Function
'-----------------------------------------

Si le fichier jpg n'a pas de "date de cliché"
j'ai retenu FileDateTime comme "Date de création"

'------------------------------------
Sub toto()
MsgBox Date_Du_Cliché("c:Exceltoday", "03A.jpg")
End Sub
'------------------------------------

Function Date_Du_Cliché(chemin As String, _
Fichier As String) As Date
'Microsoft Shell Controls and Automation
Dim MyShell As New Shell, X As Date
Dim Dossier As Shell32.Folder
Dim MyFile As ShellFolderItem
Set Dossier = MyShell.Namespace(chemin)
Set MyFile = Dossier.Items.Item(Fichier)
On Error Resume Next
X = Dossier.GetDetailsOf(MyFile, 25)
If Err <> 0 Then Err.Clear: X = VBA.FileDateTime(chemin & Fichier)
Date_Du_Cliché = X
End Function
'------------------------------------


Pour lister tous les fichier "JPG" d'un répertoire et leur date
de "cliché" ou de création :

'------------------------------------
Sub Date_Du_Cliché(chemin)
'Microsoft Shell Controls and Automation
Dim MyShell As New Shell, X As Date
Dim Dossier As Shell32.Folder
Dim MyFile As ShellFolderItem
Dim F As String, Lig As Long

ActiveWorkbook.Sheets.Add after:=Sheets(Sheets.Count)

Set Dossier = MyShell.Namespace(chemin)
Range("A1") = "Nom du Fichier"
Range("B1") = "Date de création"
Range("A1:B1").Font.Bold = True
Lig = 2
F = Dir(chemin & "*.jpg")
On Error Resume Next
Do While Len(F) > 0
Set MyFile = Dossier.Items.Item(F)
Cells(Lig, 1) = Dossier.GetDetailsOf(MyFile, 0)
'Date du cliché
X = Dossier.GetDetailsOf(MyFile, 25)
If Err <> 0 Then
Err.Clear
'Si date du cliché n'existe pas...
X = VBA.FileDateTime(chemin & F)
End If
Cells(Lig, 2) = X
Lig = Lig + 1
F = Dir
Loop
Range("A1:AI1").Font.Bold = True
Range("A:AI").EntireColumn.AutoFit
Set MyShell = Nothing: Set MyFolder = Nothing: Set MyFile = Nothing

End Sub
'------------------------------------

| Tu as dû louper mon post de ce matin où je faisais remarquer qu'il est
| en colonne Z

Absoluement pas, je répondais à Daniel à propos du fichier (photo) au
format jpg qu'il m'a envoyé en bal perso.

MERCI pour tout
Je viens de voir les nombreuses réponses à ma question.
Je pense arriver à faire ce que je veux avec tous ces renseignements.
Je cherche en fait à me perfectionner dans l'utilisation de Excel et VBA
aussi vos réponses quelqu'elles soient m'aident beaucoup.
Olivier


"michdenis" <michdenis@hotmail.com> a écrit dans le message de news:
uQRreZj9IHA.1204@TK2MSFTNGP04.phx.gbl...

Si le fichier jpg n'a pas de "date de cliché"
j'ai retenu FileDateTime comme "Date de création"

'------------------------------------
Sub toto()
MsgBox Date_Du_Cliché("c:Exceltoday", "03A.jpg")
End Sub
'------------------------------------

Function Date_Du_Cliché(chemin As String, _
Fichier As String) As Date
'Microsoft Shell Controls and Automation
Dim MyShell As New Shell, X As Date
Dim Dossier As Shell32.Folder
Dim MyFile As ShellFolderItem
Set Dossier = MyShell.Namespace(chemin)
Set MyFile = Dossier.Items.Item(Fichier)
On Error Resume Next
X = Dossier.GetDetailsOf(MyFile, 25)
If Err <> 0 Then Err.Clear: X = VBA.FileDateTime(chemin & Fichier)
Date_Du_Cliché = X
End Function
'------------------------------------


Pour lister tous les fichier "JPG" d'un répertoire et leur date
de "cliché" ou de création :

'------------------------------------
Sub Date_Du_Cliché(chemin)
'Microsoft Shell Controls and Automation
Dim MyShell As New Shell, X As Date
Dim Dossier As Shell32.Folder
Dim MyFile As ShellFolderItem
Dim F As String, Lig As Long

ActiveWorkbook.Sheets.Add after:=Sheets(Sheets.Count)

Set Dossier = MyShell.Namespace(chemin)
Range("A1") = "Nom du Fichier"
Range("B1") = "Date de création"
Range("A1:B1").Font.Bold = True
Lig = 2
F = Dir(chemin & "*.jpg")
On Error Resume Next
Do While Len(F) > 0
Set MyFile = Dossier.Items.Item(F)
Cells(Lig, 1) = Dossier.GetDetailsOf(MyFile, 0)
'Date du cliché
X = Dossier.GetDetailsOf(MyFile, 25)
If Err <> 0 Then
Err.Clear
'Si date du cliché n'existe pas...
X = VBA.FileDateTime(chemin & F)
End If
Cells(Lig, 2) = X
Lig = Lig + 1
F = Dir
Loop
Range("A1:AI1").Font.Bold = True
Range("A:AI").EntireColumn.AutoFit
Set MyShell = Nothing: Set MyFolder = Nothing: Set MyFile = Nothing

End Sub
'------------------------------------