Changer date et heure d'un fichier

Bonjour,
fonction directe a priori plus compliqué comme tu l'indiques
voici plutôt comment faire directement:

stocker la date et heure système
changer la date et heure système
ouvrir le fichier et l'enregistrer.
remettre la date et heure système.

Sub otherDate()
Dim MyDate, theDate
theDate = Date
MyDate = #12/24/2005#
Date = MyDate
Workbooks.Open "c:truc.xls"
ActiveWorkbook.Close True
Date = theDate

End Sub

'Cdlt

'lSteph

Bonjour,
Y a t'il une fonction directe pour changer la date et l'heure d'un fichier ?
j'ai cherché sur le net, j'ai trouvé un code en passant par les API, ca m'a
l'air bien important. Dans le temps ,je programmais en C sous MSDOS en
appelant une intérruption sytème c'était relativement souple..
merci d'avance
bruno

..pour l'heure idem avec time (voir l'aide c'est dedans)

@+

lSteph

..pour l'heure idem avec time (voir l'aide c'est dedans)

@+

lSteph

Bonjour à tous,

Sympa ton astuce Steph. Mais j'ai du changer les dates de fichiers jpeg
et la ... pas le choix : api !

J'ai le source au bureau et l'adresse du site qui le propose.
Si ca branche quelqu'un, je le posterais lundi.
Xav'.

Bonjour,

C'est très gentil de ta part mais je ne vois pas bien où Bruno
a parlé de .jpeg

On est sur un forum Excel, donc je n'y ai pas pensé, mais pourquoi pas
Il y a des exemples d'utilisation et de codes vba sur ce forum.
Il y a aussi par analogie des exemples pour mp3 sur excelabo.


Sinon à cet effet pas besoin d'attendre lundi

et la ... pas le choix : api !
Ah bon!tu semble bien sûr de cela, il ya pourtant nombre de chemins qui

mènent à Rome.
S'agissant de .jpeg il me semble que cela se passe plutôt dans les EXIF
pour aller récupèrer:
Nom Taille Type Date de modification Date de création Date d'accès
Attributs État Propriétaire Auteur Titre Objet Catégorie Pages
Commentaires Copyright Artiste Titre de l'album Année Numéro de
piste Genre Durée Débit Protégée Modèle d'appareil photo Date du
cliché Dimensions Nom de l'épisode Description du programme Taille de
l'échantillon audio Taux d'échantillonnage audio Chaînes
En vba je sais lire* mais pour écrire même si pas besoin directement
d'API c'est beaucoup plus compliqué.

Voir des solutions ici:
http://files.codes-sources.com/fichier.aspx?id%744&f=EXIFWrite.bas

Cordialement.

lSteph

*Exemple de ma petite cuisine en vba pour lire les propriétés d'un jpeg
Suppose qu'on passe un chemin en paramêtre

'''''****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
Sub LeDir()
Dim i As Long

With Application.FileSearch


.LookIn = "C:"
.SearchSubFolders = True
.FileName = "*.jpg"


If .Execute() > 0 Then
Feuil1.[d:d].ClearContents
Feuil1.[d1] = "Fichiers"
For i = 1 To .FoundFiles.Count
Feuil1.Range("d" & i + 1) = .FoundFiles(i)
Next i


End If
End With


End Sub


Sub lesChemins()
Dim c As Range
For Each c In Feuil1.Range("d2", [d65536].End(xlUp)).Cells
c.Offset(0, 1) = duchemin(c.Text)
Next
[e1] = "Répertoires"
FiltChemins
Range("d:e").ClearContents
End Sub
Sub FiltChemins()


Range("e1", [e65536].End(xlUp)).Select
Selection.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range("a1"), Unique:=True
End Sub


Function duchemin(fichier As String)
Dim i As Integer, revF As String
For i = Len(fichier) To 1 Step -1
revF = revF & Mid(fichier, i, 1)
Next


revF = Mid(revF, Application.WorksheetFunction.Find("", revF), 999)
For i = Len(revF) To 1 Step -1
duchemin = duchemin & Mid(revF, i, 1)
Next
duchemin = Mid(duchemin, 1, Len(duchemin) - 1)
End Function

'''''****code Feuil1*******
Option Explicit

Private Sub CommandButton1_Click()
LeDir
lesChemins
End Sub
''suppose qu'en target du dblclick on met les chemins
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
If Target.Column = 1 And Not IsEmpty(Target.Value) Then _
LireInfosJpg (Target.Value)
End Sub

..pour l'heure idem avec time (voir l'aide c'est dedans)

@+

lSteph

Bonjour à tous,

Sympa ton astuce Steph. Mais j'ai du changer les dates de fichiers jpeg
et la ... pas le choix : api !

J'ai le source au bureau et l'adresse du site qui le propose.
Si ca branche quelqu'un, je le posterais lundi.
Xav'.