modifier la date d'un fichier

Bonjour,

Franck wrote:

bonjour,

dans une macro qui copie automatiquement les mails en .msg j'aimerai pouvoir
changer les attributs de date du fichier pour aovir la date de reception du
mail.
Actuellement au moment de l'entregistrement ça me met la date du jour......


comment faire ?

Merci a tous !

Des pistes ici :

http://vb.mvps.org/samples/project.asp?id=fileinfo

voir l'api SetFileTime dans le module de classe CFileInfo.cls

Le téléchargement de 'FileInfo.zip' est en bas de la page

Bon courage.


--
Cordialement,

Jacques.

Salut Franck,

Copie le code dans une feuille sur laquelle tu crées

- un textbox TxtFileName
- 3 commandbutton Valid(0 à 2) avec valider date 0, annuler pour 1, valider
nom de fichier pour 2
- 3 label OldDate(0 à 2) pour le jour, le mois, l'année actuels (séparés par
des '/')
- 3 label OldTime(0 à 2) pour les heures, minutes, secondes actuels (séparés
par des ':')
- 3 texbox NewDate(0 à 2) pour le jour, le mois, l'année à modifier (séparés
par des '/')
- 3 texbox NewTime(0 à 2) pour les heures, minutes, secondes à modifier
(séparés par des ':')

On peut toujours faire mieux, mais ce code fonctionne.

--
Aski

AntiSpamEdit et traduction française de k9
http://h.dechily.free.fr/
http://h.charlier.de.chily.perso.cegetel.net/

Option Explicit

Private Const OF_READWRITE = &H2
Private Const OF_Attr = OF_READWRITE

Private Type Struct
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(128) As Byte
End Type

Private Type fTime
LowTime As Long
HighTime As Long
End Type

Private Type sTime
iYear As Integer
iMonth As Integer
iDayOfWeek As Integer
iDay As Integer
iHour As Integer
iMin As Integer
iSec As Integer
iMs As Integer
End Type

'ouverture du fichier (la valeur retournée est l'identificateur)
Private Declare Function OpenFile Lib "kernel32" _
(ByVal fName As String, fStruct As Struct, _
ByVal Style As Long) As Long

'lire les attributs dates et heures du fichier
Private Declare Function GetFileTime Lib "kernel32" _
(ByVal hFile As Long, CreationTime As fTime, _
AccessTime As fTime, WriteTime As fTime) As Long

'pour la récupération des paramètres date, heure, minutes, secondes
'convertir les dates et heures du dernier enregistrement
'exprimées en Coordinated Universal Time (UTC)
'en dates et heures locales
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" _
(FileTime As fTime, LocalFileTime As fTime) As Long
'puis en dates et heures système
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
(FileTime As fTime, SysTime As sTime) As Long

'pour l'engegistrement des paramètres date, heure, minutes, secondes
'convertir les dates et heures système en dates et heures locales
Private Declare Function SystemTimeToFileTime Lib "kernel32" _
(SysTime As sTime, FileTime As fTime) As Long
'convertir les dates et heures système en dates et heures locales
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" _
(LocalFileTime As fTime, FileTime As fTime) As Long
'convertir les dates et heures locales en Coordinated Universal
'Time (UTC)

'écrire les attributs dates et heures du fichier
Private Declare Function SetFileTime Lib "kernel32" _
(ByVal hFile As Long, CreationTime As fTime, _
AccessTime As fTime, WriteTime As fTime) As Long

'fermer le fichier
Private Declare Function lclose Lib "kernel32" Alias "_lclose" _
(ByVal hFile As Long) As Long

Private hFile As Long
Private fName As String, sNewDate As String
Private flgAttr As Boolean, Begin As Boolean
Private CreationTime As fTime, AccessTime As fTime
Private LocalTime As fTime, WriteTime As fTime
Private SysTime As sTime
Private Attr As VbFileAttribute

Private Sub Form_Load()
'désactivation des zones de saisie
InitZones False
'initialisation du nom de fichier à celui du fichier ouvert
txtFileName = FileOpened
End Sub

Private Function FileExists(File As String) As Boolean
On Error GoTo Test
'détermine l'existence d'un fichier
FileExists = True
If FileLen(File) > 0 Then Exit Function
Test:
FileExists = False
End Function

Private Sub DecodeDate()
Dim TempFile As Long
Dim S As String
Dim fStruct As Struct
fName = txtFileName.Text
'changer l'attribut lecture seule
Attr = GetAttr(fName)
'les attributs ont l'une ou une combinaison des valeurs suivantes

'vbNormal 0 Normal (valeur par défaut pour Dir et SetAttr)
'vbReadOnly 1 Lecture seule
'vbHidden 2 Masqué
'vbSystem 4 Fichier système
'vbVolume 8 Nom de volume
'vbDirectory 16 Répertoire ou dossier
'vbArchive 32 Fichier modifié depuis la dernière sauvegarde
If Attr Mod 2 > 0 Then
SetAttr fName, Attr - vbReadOnly: flgAttr = True
End If
'ouvrir le fichier et en déterminer l'identificateur
hFile = OpenFile(fName, fStruct, OF_Attr)
'lire les attributs dates et heures du fichier
GetFileTime hFile, CreationTime, AccessTime, WriteTime
'convertir les dates et heures du dernier enregistrement
'exprimées en Coordinated Universal Time (UTC)
'en dates et heures locales
FileTimeToLocalFileTime WriteTime, LocalTime
'puis en dates et heures système
FileTimeToSystemTime LocalTime, SysTime
'initialisation des heures secondes et minutes aux valeurs actuelles
With SysTime
OldDate(0) = .iDay: NewDate(0) = .iDay
OldDate(1) = .iMonth: NewDate(1) = .iMonth
OldDate(2) = .iYear: NewDate(2) = .iYear
OldTime(0) = Format(.iHour, "00")
NewTime(0) = Format(.iHour, "00")
OldTime(1) = Format(.iMin, "00")
NewTime(1) = Format(.iMin, "00")
OldTime(2) = Format(.iSec, "00")
NewTime(2) = Format(.iSec, "00")
End With
'donner le focus au premier digit
NewDate(0).SetFocus
End Sub

Private Sub NewDate_KeyPress(Ind As Integer, Key As Integer)
'contrôle dynamique du clavier pour les entrées dates
Select Case Key
Case 13 'Entrée
'donner le focus à la zone suivante
If Ind = 2 Then NewTime(0).SetFocus Else NewDate(Ind + 1).SetFocus
Case 27 'Échap
'donner le focus à la zone précédente
If Ind = 0 Then
Valid(1).Enabled = True: Valid(1).SetFocus ':Valid(1) = True
Else: NewDate(Ind - 1).SetFocus
End If
Case Is < 32 'caractère non affichable
'sortie par exemple si effacement
Exit Sub
Case Is < 48, Is > 57 'non numérique
'annuler la saisie
Key = 0
Case Else
'effacement de la zone si saisie en première position
If NewDate(Ind).SelStart = 0 Then NewDate(Ind) = ""
End Select
End Sub

Private Sub NewTime_KeyPress(Ind As Integer, Key As Integer)
'contrôle dynamique du clavier pour les entrées heure, minute, seconde
Select Case Key
Case 13 'Entrée
'donner le focus à la zone suivante
If Ind = 2 Then
Valid(0) = True: Valid(0).Enabled = True: Valid(0).SetFocus
'Valid(0)=True
Else: NewTime(Ind + 1).SetFocus
End If
Case 27 'Échap
'donner le focus à la zone précédente
If Ind = 0 Then NewDate(2).SetFocus Else NewTime(Ind - 1).SetFocus
Case Is < 32 'caractère non affichable
'sortie par exemple si effacement
Exit Sub
Case Is < 48, Is > 57 'non numérique
Key = 0
Case Else
'effacement de la zone si saisie en première position
If NewTime(Ind).SelStart = 0 Then NewTime(Ind) = ""
End Select
End Sub

Private Sub NewDate_LostFocus(Ind As Integer)
Dim x As Integer, Ok As Boolean
'sortie s'il ne s'agit pas d'une saisie
If Begin Then Exit Sub
'contrôles de validité
'conversion de la chaîne en entier
x = CInt(NewDate(Ind)): Ok = DateOk
Select Case Ind
Case 0
'refus d'un jour non compris entre 1 et 31
If x < 1 Or x > 31 Then
NewDate(Ind) = "": NewDate(Ind).SetFocus
Else: NewDate(Ind) = x
End If
Case 1
'refus d'un mois non compris entre 1 et 12
If x < 1 Or x > 12 Then
NewDate(Ind) = "": NewDate(Ind).SetFocus
Else: NewDate(Ind) = x
End If
Case 2
'refus d'une année inférieure à 1970 (date initiale de codage)
If x < 1970 Then
NewDate(Ind) = "": NewDate(Ind).SetFocus
ElseIf Ok Then NewDate(Ind) = x
Else: NewDate(0).SetFocus
End If
End Select
End Sub

Private Sub NewTime_LostFocus(Ind As Integer)
Dim x As Integer, Ok As Boolean
'contrôles de validité
'conversion de la chaîne en entier
x = CInt(NewTime(Ind))
Select Case Ind
Case 0
'refus d'une heure non comprise entre 0 et 24
If x < 0 Or x > 24 Then
NewTime(Ind) = "": NewTime(Ind).SetFocus
Else: NewTime(Ind) = x
End If
Case 1, 2
'refus des minutes et secodes non comprises entre 0 et 60
If x < 0 Or x > 60 Then
NewTime(Ind) = "": NewTime(Ind).SetFocus
Else: NewTime(Ind) = x
End If
End Select
'formatage
NewTime(Ind) = Format(CInt(NewTime(Ind)), "00")
End Sub

Private Function DateOk() As Boolean
'contrôle de la validité globale de la date
DateOk = False
sNewDate = NewDate(0) & "/" & NewDate(1) & "/" & NewDate(2)
If IsDate(sNewDate) Then
DateOk = True: Valid(0).Enabled = True
Else: Valid(0).Enabled = False
End If
End Function

Private Sub TxtFileName_Change()
'désactivation des zones de saisie pour un nouveau fichier
InitZones False
End Sub

Private Sub Valid_Click(Ind As Integer)
Dim S As String
Select Case Ind
Case 0 'Validation
With SysTime
'conversion des paramètres en entiers
.iDay = CInt(NewDate(0)): .iMonth = CInt(NewDate(1))
.iYear = CInt(NewDate(2))
.iHour = CInt(NewTime(0)): .iMin = CInt(NewTime(1))
.iSec = CInt(NewTime(2))
End With
'convertir les dates et heures système en dates et heures locales
SystemTimeToFileTime SysTime, LocalTime
'convertir les dates et heures locales en Coordinated Universal
'Time (UTC)
LocalFileTimeToFileTime LocalTime, WriteTime
'écrire les attributs dates et heures du fichier
SetFileTime hFile, CreationTime, AccessTime, WriteTime
'fermeture du fichier
lclose hFile
S = FileDateTime(fName)
'en cas de lecture seule du fichier, rétablissement de
'l'attribut initial
If flgAttr Then SetAttr fName, Attr
'désactivation des zones de saisie
InitZones False
Case 1 'Annulation
'fermeture du fichier ouvert et déchargement
lclose hFile: Unload Me
Case 2 'validation du nom du fichier
fName = txtFileName.Text
'vérifier l'xistence du fichier
If FileExists(fName) Then
InitZones True
DecodeDate
Exit Sub
Else
InitZones False
MsgBox "Ce fichier n'existe pas"
End If
End Select
End Sub

Private Sub InitZones(Test As Boolean)
'désactivation des zones de saisie
Begin = True
fraNewDate.Enabled = Test
fraNewTime.Enabled = Test
Valid(0).Enabled = Test
Begin = False
End Sub

Franck wrote:
|| bonjour,
||
|| dans une macro qui copie automatiquement les mails en .msg j'aimerai
|| pouvoir changer les attributs de date du fichier pour aovir la date
|| de reception du mail.
|| Actuellement au moment de l'entregistrement ça me met la date du
|| jour......
||
||
|| comment faire ?
||
|| Merci a tous !