Interpreto il tuo messaggio come una richiesta di un "ulteriore"
aiutino con le macro...
Ci provo ma se non hai "qualche rudimento" rischiamo di non andare lontano (e spero che non abbia abbandonato la strada della "regola Outlook", che rimane sempre valido se con le macro non arriviamo a qualcosa di utilizzabile)
Allora...
1) Intanto devi installare sul tuo Pc l'ambiente Selenium, sequendo le istruzioni che trovi qui:
viewtopic.php?f=26&t=1122252) Apri il Vba do Outlook (Alt-F11 dovrebbe bastare); cerca nel frame "Progetto" il modulo ThisOutlookSession, e inserisci nel frame di destra questo codice:
- Codice: Seleziona tutto
Private Sub Application_NewMail()
FromFlag = True
Call ScanForMail
End Sub
Private Sub Application_Startup()
If WPage Is Nothing Then
Set WPage = CreateObject("Selenium.WebDriver")
WPage.Start "Chrome"
End If
End Sub
La prima Sub dice di avviare la Sub ScanForMail quando arriva una nuova email
La seconda dice di aprire una sessione Chrome quando avvii Outlook; usa questa sessione per collegarti al portale che serve e a loggarti se necessario.
3) Crea un nuovo modulo standard vba (Menu /Inserisci /Modulo), e in questo modulo inserisci questo codice:
- Codice: Seleziona tutto
Option Explicit
Public WPage As Selenium.WebDriver, FromFlag As Boolean
Sub ScanForMail()
Dim myNameSpace As NameSpace
Dim myInFolder As Folder, myItem As Object, myBody As String
Dim dTime As Single, inBody As Long, Memo As Long
Dim Sender As String, LFor As String, LinkHelpr As String
Dim myLink As String, Risp As Long, sHref As Long, eHref As Long
'
Sender = "pippolino@" '<<< il Mittente
LFor = "Invio" '<<< La chiave ca cercare nel Subject
LinkHelpr = "http://www.iv" '<<< L'inizio del link da cercare
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
'
If FromFlag Then dTime = 0.02 Else dTime = 1000 'Imposta la finestra di tempo in cui cercare
'
Debug.Print String(5, Chr(10))
Debug.Print ">>>>>>>>>>>>>>>>>>>>", Now
If WPage Is Nothing Then
Set WPage = CreateObject("Selenium.WebDriver")
WPage.Start "Chrome"
Memo = 5
Debug.Print "Creata Wpage"
End If
'
For Each myItem In myInFolder.Items 'Scansione delle mail in Inbox
If TypeName(myItem) = "MailItem" Then
If InStr(1, myItem.Sender, Sender, vbTextCompare) = 1 And _
InStr(1, myItem.Subject, LFor, vbTextCompare) > 0 Then 'Trovato Mittente e Chiave...
If myItem.ReceivedTime > (Now - dTime) Then '... verifica la finestra di tempo
If InStr(1, myItem.Subject, "#_#", vbTextCompare) = 0 Then '... verifica che non sia gia' stata processata
myBody = myItem.HTMLBody 'Esamina il testo...
inBody = InStr(1, myBody, LinkHelpr, vbTextCompare) '... e cerca il link
'' Debug.Print "A", myItem.Subject, myItem.Sender, myItem.ReceivedTime 'Debug.Print
If inBody > 0 Then 'Se lo trova presente...
Debug.Print "A", myItem.Subject, myItem.Sender, myItem.ReceivedTime 'Debug.Print
sHref = InStrRev(Mid(myBody, 1, inBody), Chr(34), , vbTextCompare) '...lo cerca meglio
eHref = InStr(sHref + 1, myBody, """", vbTextCompare)
If eHref > (sHref + 2) Then
Debug.Print "A1+", Mid(myBody, inBody - 10, 30) 'Debug.print
myLink = Mid(myBody, sHref + 1, eHref - sHref - 1) '...lo seleziona
Risp = cLink(myLink) 'Chiama il processo di Click
If Risp > 0 Then 'Esito positivo
Debug.Print "+++", myLink, myItem.Subject, myItem.Sender, myItem.ReceivedTime
myItem.Subject = myItem.Subject & " #_#" & Risp
myItem.Save
WPage.GoBack
Else 'Esito negativo
MsgBox ("Ambiente Selenium non attivo; chiudere e riaprire Outlook")
End If
Else
Debug.Print "A2-", "Link non trovato"
End If
End If
End If
End If
End If
Else
Debug.Print "---" 'Non e' una mail
End If
Next myItem
'Chiusura:
If FromFlag = False And Memo > 0 Then 'Se non attivata da New Email
On Error Resume Next
WPage.Quit
Set WPage = Nothing
On Error GoTo 0
Else
WPage.GoBack
End If
FromFlag = False
Debug.Print "<<<<<<<<<<<<<<<<<<<<<<<"
Beep
End Sub
Function cLink(Linkkk) As Long
Dim Memo As Long
'
If WPage Is Nothing Then
If FromFlag Then
cLink = 0 'Non ok
Exit Function
Else
If WPage Is Nothing Then
Set WPage = CreateObject("Selenium.WebDriver")
WPage.Start "Chrome", Linkkk
WPage.Get "/"
Memo = 5
End If
If WPage.URL = Linkkk Then
cLink = 1 + Memo 'Certamente Ok
Else
cLink = 2 + Memo 'Maybe Ok
End If
If Memo > 0 Then
WPage.Quit
Set WPage = Nothing
End If
Exit Function
End If
Else
WPage.Get Linkkk
If WPage.URL = Linkkk Then
cLink = 1 'Certamente Ok
Else
cLink = 2 'Maybe Ok
End If
End If
End Function
In testa al codice ci sono tre righe marcate <<< che vanno personalizzate come da commento; in particolare nella riga
LinkHelpr = etc etc indicherai la parte iniziale del link, piu' lunga possibile (al limite "tutto", se come dici i link e' sempre lo stesso (ma la cosa mi sembra strana)
La macro dovrebbe cercare all'interno dell'Inbox le mail che partono da un certo destinatario, che nel Subject abbiano una certa chiave se esiste un hyperlink simile a quello indicato nella riga LinkHelpr = xxxx; se lo trova allora
-dovrebbe attivare la finestra Chrome per navigare fino a quel link; non so se a questo punto e' prevista una qualche manualita'; ora la macro continua imperterrita cercando altre email con quelle caratteristiche fino alla fine dell'Inbox
La ricerca viene fatta su due finestre di tempo:
-circa 30 minuti, se la ScanForMail parte per azione di una mail in entrata
-1000 giorni se invece viene avviata manualmente (ad esempio la prima volta)
Le mail che attivano l'hyperlink nella finestra Chrome avranno il loro Subject modificato con postambolo "#_#x"; questa appendice viene usata per impedire alla stessa mail di attivare il link piu' volte
Dopo aver inserito tutto il codice puoi avviare la Sub ScanForMail, magari utilizzando un piccolo lotto di email in Inbox, per vedere l'effetto che fa.
Completata la macro (che non causa nessun messaggio oltre a un Beep) puoi andare sul vba, aprire la finestra Immediata (dovrebbe bastare) dove troverai un elenco di informazioni diagnostiche. Controlla nell'elenco mail se le mail col link hanno il suffisso #_# nel Subject.
Ci sono informazioni probabilmente riservate; se vuoi condividere quel log allora fai la sostituzione delle parte riservate con ***** (lo puoi fare in Word con Trova /Sostituisci)
A un certo punto chiudi Outlook: ti chiedera' se vuoi salvare il progetto (le macro) e risponderai Sì. Poi riaprilo: dovrebbe ora aprirsi anche quella finestra di Chrome da riservare alla macro; se c'e' qualche operazione preventiva da fare falla adesso.
Difficile che funzioni tutto, difficile capire se il link ha funzionato o meno, difficile che lo possa debuggare io da remoto; insomma non so quanto lontano arriviamo...
Mi preoccupa anche un'altra cosa: probabilmente cliccare su Accept serve a confermare una assunzione di responsabilita' del ricevente; che questa sia surrogata da una macro mi sembra non conforme
Registrazione
