1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
'http://www.cathyastuce.com/vba/code-source-excel/manipulation-fichiers/420-modif-dates.html
Public Const OFS_MAXPATHNAME = 260
Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
Type FILETIME
dwLowDate As Long
dwHighDate As Long
End Type
Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMillisecs As Integer
End Type
' constante
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_EXISTING = 3
' declarations api
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Declare Function LocalFileTimeToFileTime Lib "kernel32" _
(lpLocalFileTime As FILETIME, _
lpFileTime As FILETIME) As Long
Declare Function SetFileTime Lib "kernel32" _
(ByVal hFile As Long, _
lpcreation As FILETIME, _
lpLecture As FILETIME, _
lpLastWriteTime As FILETIME) As Long
Declare Function GetFileTime Lib "kernel32" _
(ByVal hFile As Long, lpCreationTime As FILETIME, _
lpLastAccessTime As FILETIME, _
lpLastWriteTime As FILETIME) As Long
Declare Function SystemTimeToFileTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME, _
lpFileTime As FILETIME) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, _
lpSystemTime As SYSTEMTIME) As Long
Public Function GetFT(sDate) As FILETIME
Dim udtSysTime As SYSTEMTIME
Dim udtLocalTime As FILETIME
Dim Ft As FILETIME
Dim RetVal As Long
With udtSysTime
.wYear = Year(sDate)
.wMonth = Month(sDate)
.wDay = Day(sDate)
.wDayOfWeek = Weekday(sDate) - 1
.wHour = Hour(sDate)
.wMinute = Minute(sDate)
.wSecond = Second(sDate)
End With
RetVal = SystemTimeToFileTime(udtSysTime, udtLocalTime)
RetVal = LocalFileTimeToFileTime(udtLocalTime, GetFT)
End Function
Public Function GetFileDateString(CT As FILETIME, sFormat As String) As String
Dim ST As SYSTEMTIME
Dim ds As Single
'Convertir les infos du fichier en un format temps affichable
If FileTimeToSystemTime(CT, ST) Then
ds = DateSerial(ST.wYear, ST.wMonth, ST.wDay)
GetFileDateString = Format$(ds, sFormat)
Else
GetFileDateString = ""
End If
End Function
'******** MODIFIER UN FICHIER ***********************
Public Sub ModifDate(sNomFichier As String, sDate As String, byType As Byte)
'byType = 1 =>Date de creation
'byType = 2 =>Date de Lecture
'byType = 3 =>Date derniere ecriture
'byType = 4 => toutes
Dim hFile As Long
Dim Ft As FILETIME
Dim FTc As FILETIME
Dim FTa As FILETIME
Dim FTw As FILETIME
Dim RetVal As String
hFile = CreateFile(sNomFichier, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
GetFileTime hFile, FTc, FTa, FTw
Select Case byType
Case 1
' modification Date de creation
Ft = GetFT(sDate)
RetVal = SetFileTime(hFile, Ft, FTa, FTw)
Case 2
' modification Date de Lecture
Ft = GetFT(sDate)
RetVal = SetFileTime(hFile, FTc, Ft, FTw)
Case 3
' modification Date derniere ecriture
Ft = GetFT(sDate)
RetVal = SetFileTime(hFile, FTc, FTa, Ft)
Case 4
' modification toutes
Ft = GetFT(sDate)
RetVal = SetFileTime(hFile, Ft, Ft, Ft)
End Select
End Sub |
Déplacer des mails d'Outlook vers un répertoire dans windows selon des critères
Répondre avec citation
Oliv'
Envoyé par clambsf
Partager