Discussion :

[upltu]

Bonjour,

Chrome est le navigateur par défaut défini pour les liens http et https. Vu que cela se passe sur mon PC de bureau et que je n'ai pas les accès Admin, voilà comment j'ai du procéder pour passer de IE à Chrome:
1. Depuis IE, roue crantée > Options Internet
2. Programmes > Définir les programmes > Associer un type de fichier ou un protocole à un programme
3. Dans la section du bas "Protocoles", j'ai modifié IE par Chrome pour HTTP et HTTPS.
À la base, je voulais mettre Firefox mais je n'ai que la version Portable donc il n'est pas disponible dans ce menu.

Bref, pour Outlook, je souhaiterais savoir s'il est possible de forcer l'ouverture des liens dans Firefox. Actuellement, je fais des copier/coller des liens, ce qui devient vite fastidieux.
Une macro serait jouable par exemple ?

Merci beaucoup pour votre aide.

[Oliv-]

Salut
Tu devrais trouver ton bonheur dans ce lien https://www.slipstick.com/developer/...email-message/

notamment en adaptant celui-ci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub OpenLinksMessage()
' author : Diane Poremsky
 Dim olMail As Outlook.MailItem
 Dim Reg1 As RegExp
 Dim M1 As MatchCollection
 Dim M As Match
 Dim strURL As String
 
Dim browserPath As String
browserPath = Chr(34) & "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & Chr(34)
 
Set olMail = Application.ActiveExplorer().Selection(1)
 
Set Reg1 = New RegExp
 
With Reg1
 .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
' opens the first link. use false to open all
 .Global = False
 .IgnoreCase = True
 End With
 
If Reg1.Test(olMail.Body) Then
 
Set M1 = Reg1.Execute(olMail.Body)
 For Each M In M1
   strURL = M.SubMatches(0)
   If InStr(strURL, "unsubscribe") Then GoTo NextURL
   If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
 
  Shell (browserPath & " -url " & strURL)
  DoEvents
 
NextURL:
  Next
  End If
 
Set Reg1 = Nothing
 End Sub

[upltu]

Salut,

Merci beaucoup pour ton aide.

1/ j'ai donc activé "Microsoft VBScript Regular Expressions 5.5" depuis Visual Basic > Outils > Références.

2/ j'ai copié ce code dans un nouveau module et dans ThisOutlookSession...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Declare PtrSafe Function ShellExecute _ 'J'ai une version 64-bit
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long
 
Sub OpenLinksMessage()
' author : Diane Poremsky
 Dim olMail As Outlook.MailItem
 Dim Reg1 As RegExp
 Dim M1 As MatchCollection
 Dim M As Match
 Dim strURL As String
 
Dim browserPath As String
browserPath = Chr(34) & "C:\Users\ID\Notes\Softs\FirefoxBetaFR\FirefoxPortable.exe" & Chr(34)
 
Set olMail = Application.ActiveExplorer().Selection(1)
 
Set Reg1 = New RegExp
 
With Reg1
 .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
 .Global = True
 .IgnoreCase = True
 End With
 
If Reg1.Test(olMail.Body) Then
 
Set M1 = Reg1.Execute(olMail.Body)
 For Each M In M1
   strURL = M.SubMatches(0)
    Debug.Print strURL
   If InStr(strURL, "unsubscribe") Then GoTo NextURL
   If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
 
   lSuccess = ShellExecute(0, "Open", strURL)
  DoEvents
 
NextURL:
  Next
  End If
 
Set Reg1 = Nothing
 End Sub

Après redémarrage, les liens sont toujours ouverts dans Chrome.

Possible que le message sur la mise à jour de sécurité pose problème ?

A security update disabled the Run a script option in Outlook 2013 and 2016's rules wizard. See Run-a-Script Rules Missing in Outlook for more information and the registry key to fix restore it.

EDIT : je précise que la macro s'exécute bien, mais dans Chrome.

[Oliv-]

Bonjour,
Est ce que tu lances bien la macro ? ce n'est pas en cliquant sur le lien que cela se fera !

[upltu]

C'est tout bon, ça fonctionne avec Iron browser (basé sur Chromium). Avec Firefox, il dit qu'une instance est déjà ouverte. Iron me va bien donc résolu pour moi.

Voici le code mis à jour :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 Private Declare PtrSafe Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long
 
Sub OpenLinksMessage()
 Dim olMail As Outlook.MailItem
 Dim Reg1 As RegExp
 Dim M1 As MatchCollection
 Dim M As Match
 Dim strURL As String
 
Dim browserPath As String
browserPath = Chr(34) & "C:\Users\ID\Notes\Softs\IronPortable64\IronPortable.exe" & Chr(34)
 
Set olMail = Application.ActiveExplorer().Selection(1)
 
Set Reg1 = New RegExp
 
With Reg1
 .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"
' opens the first link. use false to open all
 .Global = False
 .IgnoreCase = True
 End With
 
If Reg1.Test(olMail.Body) Then
 
Set M1 = Reg1.Execute(olMail.Body)
 For Each M In M1
   strURL = M.SubMatches(0)
   If InStr(strURL, "unsubscribe") Then GoTo NextURL
   If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
 
  Shell (browserPath & " -url " & strURL)
  DoEvents
 
NextURL:
  Next
  End If
 
Set Reg1 = Nothing
 End Sub