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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
|
Imports Microsoft.Office.Interop
Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Runtime.InteropServices
Imports Outlook = Microsoft.Office.Interop.Outlook
Imports Microsoft.VisualBasic
Partial Class Form1
Inherits Form
'#################### S'assurer que OUTLOOK est bien actif et trouve une fenêtre ####################
Private Function GetSelectedMail() As Outlook.MailItem
Dim app As Object = Nothing
Try
app = GetObject(, "Outlook.Application")
Catch
Return Nothing
End Try
If app Is Nothing Then Return Nothing
Try
AppActivate("Outlook")
Threading.Thread.Sleep(150)
Catch
' Outlook pas trouvé
End Try
Dim insp As Outlook.Inspector = Nothing
Try
insp = app.ActiveInspector()
Catch
End Try
If insp IsNot Nothing Then
Dim openedMail As Outlook.MailItem =
TryCast(insp.CurrentItem, Outlook.MailItem)
If openedMail IsNot Nothing Then
Return openedMail
End If
End If
Dim explorer As Outlook.Explorer = app.ActiveExplorer()
If explorer Is Nothing Then Return Nothing
If explorer.Selection Is Nothing OrElse explorer.Selection.Count = 0 Then Return Nothing
Return TryCast(explorer.Selection(1), Outlook.MailItem)
End Function
'Private Function GetSelectedMail() As Outlook.MailItem
' Dim app As New Outlook.Application()
' Dim explorer As Outlook.Explorer = app.ActiveExplorer()
' If explorer Is Nothing Then Return Nothing
' If explorer.Selection Is Nothing OrElse explorer.Selection.Count = 0 Then Return Nothing
' Return TryCast(explorer.Selection(1), Outlook.MailItem)
'End Function
'#######################################################################################################
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
For Each p As Process In Process.GetProcessesByName("MACROMAIL")
Try
p.Kill()
Catch
End Try
Next
End Sub
'############################## Format d'enregistrement ############################################
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' Ne rien faire au chargement
End Sub
'#######################################################################################################
Private Function SanitizeFileName(fileName As String) As String
Dim invalidChars As Char() = System.IO.Path.GetInvalidFileNameChars()
For Each c As Char In invalidChars
Select Case c
Case "/"c
fileName = fileName.Replace(c, "-"c)
Case ";"c, ","c
fileName = fileName.Replace(c, "."c)
Case Else
fileName = fileName.Replace(c, "_"c) ' Remplace les autres caractères invalides par un underscore
End Select
Next
Return fileName
End Function
'##################################################################
Private Sub BoutonChercher_Click(sender As Object, e As EventArgs) Handles BoutonChercher.Click
Dim CheminAffaire = TrouverCheminAffaire(TBNumAff.Text)
If CheminAffaire <> String.Empty Then
TBPath.Text = CheminAffaire
Else
MessageBox.Show("Aucune affaire trouvée.")
End If
End Sub
Private Function TrouverCheminAffaire(numAff As String) As String
If String.IsNullOrWhiteSpace(numAff) Then Return String.Empty
Dim dossierRacine As String = "N:\"
Dim anneeCourante As Integer = Date.Now.Year
Dim anneeMin As Integer = 2010
For annee As Integer = anneeCourante To anneeMin Step -1
Dim dossierAnnee As String = Path.Combine(dossierRacine, "AFFAIRE " & annee)
If Directory.Exists(dossierAnnee) Then
For Each dossierAffaire As String In Directory.GetDirectories(dossierAnnee)
If Path.GetFileName(dossierAffaire).Contains(numAff) Then
Return dossierAffaire
End If
Next
End If
Next
Return String.Empty
End Function
'######################## Sélectionner le dossier manuellement ####################################
Private Sub BoutonPath_Click(sender As Object, e As EventArgs) Handles BoutonPath.Click
Dim folderDialog As New FolderBrowserDialog()
If folderDialog.ShowDialog() = DialogResult.OK Then
TBPath.Text = folderDialog.SelectedPath ' Remplacer TBPath par le nom réel de votre TextBox
End If
End Sub
'######################## Rafraîchir le nom du fichier ############################################
Private Sub BoutonRefresh_Click(sender As Object, e As EventArgs) Handles BoutonRefresh.Click
Dim mailItem As Outlook.MailItem = GetSelectedMail()
If mailItem Is Nothing Then
MessageBox.Show("Veuillez sélectionner un email dans Outlook.")
Exit Sub
End If
Dim dateFormat As String = mailItem.SentOn.ToString("yyyy MM dd")
Dim envoyeur As String = If(mailItem.SenderEmailAddress, "Expéditeur inconnu")
Dim recipients As String = ""
If Not String.IsNullOrWhiteSpace(mailItem.To) Then
recipients = String.Join(", ",
mailItem.To.Split(";"c).Select(Function(s) s.Trim()))
End If
Dim cc As String = ""
If Not String.IsNullOrWhiteSpace(mailItem.CC) Then
cc = String.Join(", ",
mailItem.CC.Split(";"c).Select(Function(s) s.Trim()))
End If
Dim subject As String = If(mailItem.Subject, "")
Dim fileName As String = $"{dateFormat} - {envoyeur} à {recipients} - {cc} - {subject}"
TBName.Text = SanitizeFileName(fileName)
End Sub
Private Sub BoutonSave_Click(sender As Object, e As EventArgs) Handles BoutonSave.Click
If String.IsNullOrWhiteSpace(TBPath.Text) OrElse String.IsNullOrWhiteSpace(TBName.Text) Then
MessageBox.Show("Veuillez renseigner un chemin et un nom de fichier.")
Exit Sub
End If
Dim mailItem As Outlook.MailItem = GetSelectedMail()
If mailItem Is Nothing Then
MessageBox.Show("Veuillez sélectionner un email dans Outlook.")
Exit Sub
End If
Dim savePath As String = Path.Combine(TBPath.Text, TBName.Text & ".msg")
mailItem.SaveAs(savePath, Outlook.OlSaveAsType.olMSG)
MessageBox.Show("Email sauvegardé avec succès !")
End Sub
Private Sub BoutonComm_Click(sender As Object, e As EventArgs) Handles BoutonComm.Click
Dim CheminAffaire As String = TrouverCheminAffaire(TBNumAff.Text)
If CheminAffaire <> String.Empty Then
TBPath.Text = CheminAffaire & "1 - COMMERCIAL"
Else
MessageBox.Show("Aucune affaire trouvée.")
End If
End Sub
Private Sub BoutonBE_Click(sender As Object, e As EventArgs) Handles BoutonBE.Click
Dim CheminAffaire As String = TrouverCheminAffaire(TBNumAff.Text)
If CheminAffaire <> String.Empty Then
TBPath.Text = CheminAffaire & "1 - BE"
Else
MessageBox.Show("Aucune affaire trouvée.")
End If
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Hide()
End Sub
End Class |
Enregistrements depuis Outlook 365
Répondre avec citation
Envoyé par bacelar
Partager