Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Transfert de fichiers photos

37 réponses
Avatar
Olivier
Bonjour,
mon APN transfère mes photos dans un dossier dont le nom est la date du
transfert.
Or je rentre de vacances et dans ce dossier, il y a des photos de 15 jours.
Je souhaiterais copier ces photos à l'aide d'Excel et VBA dans des dossiers
dont le nom est la date de prise de vue.
Est-ce possible ?
Mon problème est que j'ai déjà vu comment on récupère la liste des jpg dans
un dossier, comment on les copie,...
Mais je ne sais pas comment on peut récupérer la date du cliché (Ensuite je
suppose qu'on nomme le dossier avec pour nom la date du cliché et on copie)
Quelqu'un a une idée ?
Merci

PS: J'ai tenté d'aller voir le site Excelabo.net. On me répond page
introuvable : simple bug ou c'est plus grave ?

10 réponses

1 2 3 4
Avatar
michdenis
| ".Items" est en reverse video et le message "Membre de méthode ou de
donnée
| introuvable". Votre avis, docteur ?

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

ou bedon, sans rien décocher, tu pourrais réécrire
la procédure de cette manière en portant attention à
la déclration des objets :

'------------------------------------------------------
Sub LireInfosJpg1(chemin)
'Dans outil réferences cocher
'Microsoft Shell Controls and Automation

Dim MyShell As New Shell
Dim Dossier As Shell32.Folder
Dim i As Byte, F As String, Lig As Long

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

Set Dossier = MyShell.Namespace(chemin)
Set MyFile = Dossier.Items.Item(F)
For i = 0 To 34
If Dossier.GetDetailsOf(MyFile, i) <> "" Then _
Cells(1, i + 1) = Dossier.GetDetailsOf(MyFile, i)
Next
F = Dir(chemin & "*.jpg")
Do While Len(F) > 0
Set MyFile = Dossier.Items.Item(F)
Lig = [a65536].End(xlUp)(2).Row
For i = 0 To 34
If Dossier.GetDetailsOf(MyFile, i) <> "" Then _
Cells(Lig, i + 1) = Dossier.GetDetailsOf(MyFile, i)
Next
F = Dir
Loop
Set MyShell = Nothing: Set MyFolder = Nothing: Set MyFile = Nothing

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



"Daniel.C" a écrit dans le message de news:

Bonsoir.
J'ai une erreur de compil sur la ligne :
Set myfile = myFolder.Items.Item(f)
".Items" est en reverse video et le message "Membre de méthode ou de donnée
introuvable". Votre avis, docteur ?
Cordialement.
Daniel
"LSteph" a écrit dans le message de news:

Bonjour,

La date de création du cliché sera dans la 5ème colonne:

'''''****code Module1*******
Sub LireInfosJpg(chemin)
'Dans outil réferences cocher Microsoft Shell Controls and Automation


Dim myShell As Shell
Dim myFolder As Folder
Dim myfile As FolderItem
Dim i As Byte, f As String, lig As Long


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


Set myShell = CreateObject("Shell.Application")
Set myFolder = myShell.Namespace(chemin)
Set myfile = myFolder.Items.Item(f)
Application.ScreenUpdating = False
[a:ah].ClearContents
For i = 0 To 34
If myFolder.GetDetailsOf(myfile, i) <> "" Then _
Cells(1, i + 1) = myFolder.GetDetailsOf(myfile, i)
Next
f = Dir(chemin & "*.jpg")
Do While Len(f) > 0
Set myfile = myFolder.Items.Item(f)
lig = [a65536].End(xlUp)(2).Row
For i = 0 To 34
If myFolder.GetDetailsOf(myfile, i) <> "" Then _
Cells(lig, i + 1) = myFolder.GetDetailsOf(myfile, i)
Next
f = Dir
Loop
Set myShell = Nothing
Set myFolder = Nothing
Set myfile = Nothing
End Sub

'lSteph

Olivier a écrit :
Bonjour,
mon APN transfère mes photos dans un dossier dont le nom est la date du
transfert.
Or je rentre de vacances et dans ce dossier, il y a des photos de 15
jours.
Je souhaiterais copier ces photos à l'aide d'Excel et VBA dans des
dossiers dont le nom est la date de prise de vue.
Est-ce possible ?
Mon problème est que j'ai déjà vu comment on récupère la liste des jpg
dans un dossier, comment on les copie,...
Mais je ne sais pas comment on peut récupérer la date du cliché (Ensuite
je suppose qu'on nomme le dossier avec pour nom la date du cliché et on
copie)
Quelqu'un a une idée ?
Merci

PS: J'ai tenté d'aller voir le site Excelabo.net. On me répond page
introuvable : simple bug ou c'est plus grave ?






Avatar
michdenis
J'aurais pu enlever encore un peu plus de fioritures à la procédure
et ce serait encore mieux ... comme ceci :

'---------------------------------------
Sub LireInfosJpg1(chemin)
'Dans outil réferences cocher
'Microsoft Shell Controls and Automation

Dim MyShell As New Shell
Dim Dossier As Shell32.Folder
Dim i As Byte, F As String, Lig As Long

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

Set Dossier = MyShell.Namespace(chemin)
For i = 0 To 34
Cells(1, i + 1) = Dossier.GetDetailsOf(MyFile, i)
Next
F = Dir(chemin & "*.jpg")
Do While Len(F) > 0
Set MyFile = Dossier.Items.Item(F)
Lig = [a65536].End(xlUp)(2).Row
For i = 0 To 34
If Dossier.GetDetailsOf(MyFile, i) <> "" Then _
Cells(Lig, i + 1) = Dossier.GetDetailsOf(MyFile, i)
Next
F = Dir
Loop
Set MyShell = Nothing: Set MyFolder = Nothing: Set MyFile = Nothing

End Sub
'---------------------------------------
Avatar
michdenis
Et j'ai encore oublié d'enlever cette ligne de code inutile

If Dossier.GetDetailsOf(MyFile, i) <> "" Then _

dans la procédure publiée : :



On devrait plutôt lire :
'---------------------------------------
Sub LireInfosJpg1(chemin)
'Dans outil réferences cocher
'Microsoft Shell Controls and Automation

Dim MyShell As New Shell
Dim Dossier As Shell32.Folder
Dim i As Byte, F As String, Lig As Long

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

Set Dossier = MyShell.Namespace(chemin)
For i = 0 To 34
Cells(1, i + 1) = Dossier.GetDetailsOf(MyFile, i)
Next
F = Dir(chemin & "*.jpg")
Do While Len(F) > 0
Set MyFile = Dossier.Items.Item(F)
Lig = [a65536].End(xlUp)(2).Row
For i = 0 To 34
Cells(Lig, i + 1) = Dossier.GetDetailsOf(MyFile, i)
Next
F = Dir
Loop
Set MyShell = Nothing: Set MyFolder = Nothing: Set MyFile = Nothing

End Sub
'---------------------------------------
Avatar
LSteph
Bonjour,

Oui on peut simplifier ce que j'ai donné vient d'un classeur plus gros
que j'avais mis au point à la demande il y a un an ou deux pour
1-lister tous les réperoires (contenant les photos)
2-Extraire dans une feuille les Exif du repertoire sélectionné par
doubleclic

http://cjoint.com/?ieidXsvaeq

Après il y a pour sûr du déchet, je n'ai pas recorrigé mon code, mais si
le but est de récupèrer un élément, qui peut le + peut le -
;-)

Cordialement.

--
lSteph


michdenis a écrit :
On peut utiliser ceci pour n'obtenir que le nom des fichiers et leur date de
création.

'--------------------------------------------
Sub test()
LireInfosJpg "c:Exceltoday"
End Sub
'--------------------------------------------

Sub LireInfosJpg(chemin)
'Dans outil réferences cocher
' "Microsoft Shell Controls and Automation"

Dim MyShell As Shell, MyFolder As Folder
Dim MyFile As FolderItem
Dim F As String, Lig As Long

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

Set MyShell = CreateObject("Shell.Application")
Set MyFolder = MyShell.Namespace(chemin)
Range("A1") = "Nom du Fichier"
Range("B1") = "Date de création"
Range("A1:B1").Font.Bold = True

F = Dir(chemin & "*.jpg")
Lig = 2
Do While Len(F) > 0
Set MyFile = MyFolder.Items.Item(F)
If MyFolder.GetDetailsOf(MyFile, 0) <> "" Then
Range("A" & Lig) = MyFolder.GetDetailsOf(MyFile, 0)
Range("B" & Lig) = MyFolder.GetDetailsOf(MyFile, 4)
Lig = Lig + 1
End If
F = Dir
Loop
Range("A:B").EntireColumn.AutoFit
Set MyShell = Nothing: Set MyFolder = Nothing: Set MyFile = Nothing

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




"LSteph" a écrit dans le message de news:

Bonjour,

La date de création du cliché sera dans la 5ème colonne:

'''''****code Module1*******
Sub LireInfosJpg(chemin)
'Dans outil réferences cocher Microsoft Shell Controls and Automation


Dim myShell As Shell
Dim myFolder As Folder
Dim myfile As FolderItem
Dim i As Byte, f As String, lig As Long


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


Set myShell = CreateObject("Shell.Application")
Set myFolder = myShell.Namespace(chemin)
Set myfile = myFolder.Items.Item(f)
Application.ScreenUpdating = False
[a:ah].ClearContents
For i = 0 To 34
If myFolder.GetDetailsOf(myfile, i) <> "" Then _
Cells(1, i + 1) = myFolder.GetDetailsOf(myfile, i)
Next
f = Dir(chemin & "*.jpg")
Do While Len(f) > 0
Set myfile = myFolder.Items.Item(f)
lig = [a65536].End(xlUp)(2).Row
For i = 0 To 34
If myFolder.GetDetailsOf(myfile, i) <> "" Then _
Cells(lig, i + 1) = myFolder.GetDetailsOf(myfile, i)
Next
f = Dir
Loop
Set myShell = Nothing
Set myFolder = Nothing
Set myfile = Nothing
End Sub

'lSteph

Olivier a écrit :
Bonjour,
mon APN transfère mes photos dans un dossier dont le nom est la date du
transfert.
Or je rentre de vacances et dans ce dossier, il y a des photos de 15
jours.
Je souhaiterais copier ces photos à l'aide d'Excel et VBA dans des
dossiers
dont le nom est la date de prise de vue.
Est-ce possible ?
Mon problème est que j'ai déjà vu comment on récupère la liste des jpg
dans
un dossier, comment on les copie,...
Mais je ne sais pas comment on peut récupérer la date du cliché (Ensuite
je
suppose qu'on nomme le dossier avec pour nom la date du cliché et on
copie)
Quelqu'un a une idée ?
Merci

PS: J'ai tenté d'aller voir le site Excelabo.net. On me répond page
introuvable : simple bug ou c'est plus grave ?








Avatar
LSteph
...attention la première procèdure ( lourde) peut être fort longue
(et si la bécane a peu de ressources ça va planter si l'on clique dans
la feuille pendant l'execution, il s'affichera
ne répond pas, dans ce cas faire
Echap Ctrl+Pause
qd s'affiche la fenêtre de débogage,
cliquer ensuite sur continuer et cela va aboutir.

;-)

@+

--
lSteph


LSteph a écrit :
Bonjour,

Oui on peut simplifier ce que j'ai donné vient d'un classeur plus gros
que j'avais mis au point à la demande il y a un an ou deux pour
1-lister tous les réperoires (contenant les photos)
2-Extraire dans une feuille les Exif du repertoire sélectionné par
doubleclic

http://cjoint.com/?ieidXsvaeq

Après il y a pour sûr du déchet, je n'ai pas recorrigé mon code, mais si
le but est de récupèrer un élément, qui peut le + peut le -
;-)

Cordialement.

--
lSteph


michdenis a écrit :
On peut utiliser ceci pour n'obtenir que le nom des fichiers et leur
date de création.

'--------------------------------------------
Sub test()
LireInfosJpg "c:Exceltoday"
End Sub
'--------------------------------------------

Sub LireInfosJpg(chemin)
'Dans outil réferences cocher
' "Microsoft Shell Controls and Automation"

Dim MyShell As Shell, MyFolder As Folder
Dim MyFile As FolderItem
Dim F As String, Lig As Long

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

Set MyShell = CreateObject("Shell.Application")
Set MyFolder = MyShell.Namespace(chemin)
Range("A1") = "Nom du Fichier"
Range("B1") = "Date de création"
Range("A1:B1").Font.Bold = True

F = Dir(chemin & "*.jpg")
Lig = 2
Do While Len(F) > 0
Set MyFile = MyFolder.Items.Item(F)
If MyFolder.GetDetailsOf(MyFile, 0) <> "" Then
Range("A" & Lig) = MyFolder.GetDetailsOf(MyFile, 0)
Range("B" & Lig) = MyFolder.GetDetailsOf(MyFile, 4)
Lig = Lig + 1
End If
F = Dir
Loop
Range("A:B").EntireColumn.AutoFit
Set MyShell = Nothing: Set MyFolder = Nothing: Set MyFile = Nothing

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




"LSteph" a écrit dans le message de news:

Bonjour,

La date de création du cliché sera dans la 5ème colonne:

'''''****code Module1*******
Sub LireInfosJpg(chemin)
'Dans outil réferences cocher Microsoft Shell Controls and Automation


Dim myShell As Shell
Dim myFolder As Folder
Dim myfile As FolderItem
Dim i As Byte, f As String, lig As Long


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


Set myShell = CreateObject("Shell.Application")
Set myFolder = myShell.Namespace(chemin)
Set myfile = myFolder.Items.Item(f)
Application.ScreenUpdating = False
[a:ah].ClearContents
For i = 0 To 34
If myFolder.GetDetailsOf(myfile, i) <> "" Then _
Cells(1, i + 1) = myFolder.GetDetailsOf(myfile, i)
Next
f = Dir(chemin & "*.jpg")
Do While Len(f) > 0
Set myfile = myFolder.Items.Item(f)
lig = [a65536].End(xlUp)(2).Row
For i = 0 To 34
If myFolder.GetDetailsOf(myfile, i) <> "" Then _
Cells(lig, i + 1) = myFolder.GetDetailsOf(myfile, i)
Next
f = Dir
Loop
Set myShell = Nothing
Set myFolder = Nothing
Set myfile = Nothing
End Sub

'lSteph

Olivier a écrit :
Bonjour,
mon APN transfère mes photos dans un dossier dont le nom est la date du
transfert.
Or je rentre de vacances et dans ce dossier, il y a des photos de 15
jours.
Je souhaiterais copier ces photos à l'aide d'Excel et VBA dans des
dossiers
dont le nom est la date de prise de vue.
Est-ce possible ?
Mon problème est que j'ai déjà vu comment on récupère la liste des
jpg dans
un dossier, comment on les copie,...
Mais je ne sais pas comment on peut récupérer la date du cliché
(Ensuite je
suppose qu'on nomme le dossier avec pour nom la date du cliché et on
copie)
Quelqu'un a une idée ?
Merci

PS: J'ai tenté d'aller voir le site Excelabo.net. On me répond page
introuvable : simple bug ou c'est plus grave ?










Avatar
lSteph
As-tu bien chargé la référence indiquée en haut du programme?
On 4 août, 01:38, "Daniel.C" wrote:
Bonsoir.
J'ai une erreur de compil sur la ligne :
Set myfile = myFolder.Items.Item(f)
".Items" est en reverse video et le message "Membre de méthode ou de do nnée
introuvable". Votre avis, docteur ?
Cordialement.
Daniel
"LSteph" a écrit dans le message de news:


> Bonjour,

> La date de création du cliché sera dans la 5ème colonne:

> '''''****code Module1*******
> Sub LireInfosJpg(chemin)
> 'Dans outil réferences cocher Microsoft Shell Controls and Automatio n

> Dim myShell As Shell
> Dim myFolder As Folder
> Dim myfile As FolderItem
> Dim i As Byte, f As String, lig As Long

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

> Set myShell = CreateObject("Shell.Application")
> Set myFolder = myShell.Namespace(chemin)
> Set myfile = myFolder.Items.Item(f)
> Application.ScreenUpdating = False
> [a:ah].ClearContents
> For i = 0 To 34
> If myFolder.GetDetailsOf(myfile, i) <> "" Then _
> Cells(1, i + 1) = myFolder.GetDetailsOf(myfile, i)
> Next
> f = Dir(chemin & "*.jpg")
> Do While Len(f) > 0
> Set myfile = myFolder.Items.Item(f)
> lig = [a65536].End(xlUp)(2).Row
> For i = 0 To 34
> If myFolder.GetDetailsOf(myfile, i) <> "" Then _
> Cells(lig, i + 1) = myFolder.GetDetailsOf(myfile, i)
> Next
> f = Dir
> Loop
> Set myShell = Nothing
> Set myFolder = Nothing
> Set myfile = Nothing
> End Sub

> 'lSteph

> Olivier a écrit :
>> Bonjour,
>> mon APN transfère mes photos dans un dossier dont le nom est la date du
>> transfert.
>> Or je rentre de vacances et dans ce dossier, il y a des photos de 15
>> jours.
>> Je souhaiterais copier ces photos à l'aide d'Excel et VBA dans des
>> dossiers dont le nom est la date de prise de vue.
>> Est-ce possible ?
>> Mon problème est que j'ai déjà vu comment on récupère la lis te des jpg
>> dans un dossier, comment on les copie,...
>> Mais je ne sais pas comment on peut récupérer la date du cliché (Ensuite
>> je suppose qu'on nomme le dossier avec pour nom la date du cliché et on
>> copie)
>> Quelqu'un a une idée ?
>> Merci

>> PS: J'ai tenté d'aller voir le site Excelabo.net. On me répond pag e
>> introuvable : simple bug ou c'est plus grave ?


Avatar
lSteph
..en fait non c'est pas la bonne colonne car elle correspond à la date
de lecture des fichiers de l'appareil photo par l'ordinateur
En réalité il faut aller en colonne Z où se trouve la date du clich é
on a même le nom de l'appareil en Y
bien sûr lorsqu'il s'agit dimages JPG récupérées ou créée avec un
outil comme paint cela n'y sera pas.

--
lSteph

On 4 août, 00:10, LSteph wrote:
Bonjour,

La date de création du cliché sera dans la 5ème colonne:



Avatar
lSteph
Bonjour,

supposant que tu as lu toutes les ficelles sinon par suite, de ce que
j'avais mis au point pour la la lecture des jpg
et pour aller plus vite puisque tu veux juste la date voir
simplification par MichDenis.
Reste à boucler sur tes dates pour créer des répertoires qui
correpondront aux dates des fichiers pour que tu finisse par mettre
ces fichiers dans ces répertoires.

Faire tout ce bazar dans excel c'est certes un amusant bricolage
mais je trouve qu'il serait qd même dommage de ne pas t'indiquer qd
même que Vista te permet de ranger par année tes photos et que sinon,
tu as des outils même gratuits qui font ça très bien et te permettent
même de monter tes albums sur le web.

Exemple picassa (voir ça avec google) avec lequel tu arranges tes
albums comme tu veux, mais il y en a d'autres.
Voir aussi en complément les liens donnés par Modeste dans ce fil.

@+

lSteph


On 3 août, 10:08, "Olivier" wrote:
Bonjour,
mon APN transfère mes photos dans un dossier dont le nom est la date du
transfert.
Or je rentre de vacances et dans ce dossier, il y a des photos de 15 jour s.
Je souhaiterais copier ces photos à l'aide d'Excel et VBA dans des doss iers
dont le nom est la date de prise de vue.
Est-ce possible ?
Mon problème est que j'ai déjà vu comment on récupère la liste des jpg dans
un dossier, comment on les copie,...
Mais je ne sais pas comment on peut récupérer la date du cliché (En suite je
suppose qu'on nomme le dossier avec pour nom la date du cliché et on co pie)
Quelqu'un a une idée ?
Merci

PS: J'ai tenté d'aller voir le site Excelabo.net. On me répond page
introuvable : simple bug ou c'est plus grave ?


Avatar
Daniel.C
> 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.
Avatar
michdenis
| As-tu bien chargé la référence indiquée en haut du programme?

Si tu as un fichier dont les 2 bibliothèques suivantes sont chargées

"Microsoft Scripting RunTime"
ET
"Microsoft Shell Controls and Automation"

Si tu vas dans l'explorateur d'objets de la fenêtre de
l'éditeur de code (Raccourci clavier F2) , Choisis à tour
de rôle dans la liste déroulante "Toutes les bibliothèques"
d'abord "Scripting" de "Microsoft Scripting RunTime"
et puis "Shell32" de "Microsoft Shell Controls and Automation".

Si tu as bien pris le temps d'examiner la liste des objets de
ces 2 bibliothèques, dans chacune d'elle, on y retrouve
l'objet "Folder". Dans ta procédure, lorsque tu déclares l'objet
"MyFolder As Folder" , Comment le programme fait pour
savoir à quelle bibliothèques tu fais référence ?

Le comportement par défaut dans ce cas, le programme va
utiliser l'objet "Folder" de la première bibliothèque apparaissant
dans la liste des références que tu as cochées. Si la bibliothèque
"Microsoft Scripting RunTime" est situé avant la bibliothèque
"Microsoft Shell Controls and Automation", elle va utiliser l'objet
"Folder" de la première bibliothèque dont l'objet "Folder" fait parti.
Et dans le cas qui nous concerne, la propriété utilisée ne fait pas
parti de cet objet.

Pour que cela fonctionne, j'aurais pu proposé que tu changer la
position de la bibliothèque de la fenêtre du même nom en utilisant
les "flèches" à droite de la liste....et ça aurait fonctionné.... mais pas
sûr qu'un usager désire modifier l'ordre selon la procédure qu'il
exécute.

Dans ce cas, la meilleure solution est de spécifier dans la déclaration
des variables, la bibliothèque à laquelle appartient l'objet que l'on
veut utiliser. à cet effet, j'ai déjà publié cette procédure sur ce fil

De plus, comme il faut déclarer le nom de la bibliothèque, Il est
sage d'utiliser ce qu'on appelle "Early binding" dans la façon
de déclarer les variables...méthode réputer être un peu plus
rapide. Voilà le détail de l'explication.

---------------------------------------
Sub LireInfosJpg1(chemin)
'Dans outil réferences cocher
'Microsoft Shell Controls and Automation

Dim MyShell As New Shell
Dim Dossier As Shell32.Folder
Dim i As Byte, F As String, Lig As Long

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

Set Dossier = MyShell.Namespace(chemin)
For i = 0 To 34
Cells(1, i + 1) = Dossier.GetDetailsOf(MyFile, i)
Next
F = Dir(chemin & "*.jpg")
Do While Len(F) > 0
Set MyFile = Dossier.Items.Item(F)
Lig = [a65536].End(xlUp)(2).Row
For i = 0 To 34
Cells(Lig, i + 1) = Dossier.GetDetailsOf(MyFile, i)
Next
F = Dir
Loop
Set MyShell = Nothing: Set MyFolder = Nothing: Set MyFile = Nothing

End Sub
'------------------------------------------
1 2 3 4