Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Candidat au Club
    [URL] Ouvrir les liens avec un autre navigateur que celui par défaut
    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.

  2. #2
    Expert éminent
    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

  3. #3
    Candidat au Club
    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.

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

  5. #5
    Candidat au Club
    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

###raw>template_hook.ano_emploi###