Open multiple Hyperlinks to download files

[chummy]

Operating system::    Windows
Outlook version:     365
Email type or host:    Microsoft 365

---

Hi there, i'm completely newbie to this scripts for outlook. I need to download around 300 PDF which are hyperlinked at individual received email messages.

I'm was looking for something to automatize that, and find VBA scripts tutorial Open Hyperlinks in an Outlook Email Message

Perhaps i cannot make this work, i found this thread, which looks similar to my case.

I can run the script, but nothing happens.

 

[Diane Poremsky]

Is the macro running? add this after Set olMail = Application.ActiveExplorer().Selection(1) line or before For Each olMail In objItems if you are using the macro on multiple messages.
msgbox "started"

Does the message box come up?

 

[chummy]

Thanks for the help. I guess i done wrong statements, i still trying to understand how things work.
I'm run script with rules, but nothing happens too, no message comes up.

 

[Diane Poremsky]

Are you using this code to test the macro on a selected message? (Saves sending messages or using run rules now).

Sub RunScript()
Dim objApp As Outlook.Application
Dim objItem As MailItem

Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)

OpenLinks objItem
End Sub

Are you using 64bit Office? Below is the code for 64-bit.

' 64bit office use:
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

Public Sub OpenLinks(olMail As Outlook.MailItem)

 Dim Reg1 As RegExp
 Dim M1 As MatchCollection
 Dim M As Match
 Dim strURL As String
 Dim lSuccess As Long

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

lSuccess = ShellExecute(0, "Open", strURL)

  Next
  End If

Set Reg1 = Nothing
Set oApp = Nothing

 End Sub

Did you set a reference to Microsoft VBScript Regular Expressions library in Tools, References?