[VBA] Estrazione link da mail Outlook e apertura nel browser

[luisa227]

Ciao! Sto cercando di fare 2 cose:

1) creare una macro che mi "estrapoli", dalle mail contenute in una determinata cartella LINKSLUISA, tutti i link in esse contenuti e che me li copi in un foglio di excel.

Io sono riuscita per ora a fare un pezzettino di codice con Outlook 2003, però mi farebbe molto più comodo usare ThunderbirdPortable: si può fare in modo che una macro comunichi con ThunderbirdPortable? se sì come?
Di seguito cè il codice che sto usando, però mi manca la parte relativa alla ricerca del testo che mi serve (cioè le stringhe dei link in cui compare un www. o un http:\\). Ho visto che cè il metodo AdvancedSearch (non so se fa al caso mio), ma non ho capito come si utilizza...

'ricerca copiata da guida
Const strF As String = "urn:schemas:mailheader:subject = 'WWW.'" 'DA MODIFICARE: devo estrapolare i link contenuti nella mail
	Const strS As String = "LINKSLUISA"   
	Set sch = Application.AdvancedSearch(strS, strF)

Io avrei bisogno di ricercare nel testo della mail (cioè nel body credo) tutte le occorrenze di dove compare un www o un http ed estrapolarmi il link (usando credo i vari metodi instr, left, right, ect). Cosa devo mettere nella costante strF? cosa significa sto urn:schemas:mailheader:subject? non ho trovato spiegazioni... Mi aiutate per favore? grazie
Luisa

'mio codice
Sub PROVA()
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")

Set MYFOLDER = myNameSpace.GetDefaultFolder(olFolderInbox)

'la mia cartella su cui lavorare
Set mynewfolder = MYFOLDER.Folders("LINKSLUISA")
' rendo disponibili le items di quella cartella
Set AAA = mynewfolder.Items


' copio il testo di tutte le mail contenute in quella cartella
For Each ITM In AAA
 variabile = variabile & ITM.Body  'DA MODIFICARE: fare ricerca e estrapolazione testo (devo usare advancedsearch?)
Next


Dim xxx As Excel.Application
Set appWd = CreateObject("EXCEL.Application")
'Dim BBB As Excel.Workbook


Workbooks.Open FileName:="PROVA.xls", ReadOnly:=False

appWd.Visible = True
Sheets(1).Select
'copio il testo
Range("A1").Value = variabile  'DA MODIFICARE: non in una sola cella, ma in più celle in modo da creare un elenco

End Sub

2) tramite un altra macro, vorrei che automaticamente tutti i link presenti nell'elenco nel foglio di excel si aprissero in una finestra di Internet explorer (un link per scheda) o Firefox.

si può? che metodo posso usare?

grazie ancora
Luisa

[luisa227]

AH, ho dimenticato il codice del secondo punto.
che metodo devo usare per aprire i link nella stessa finestra e in diverse schede?
Grazie

Sub internet()

' per ogni cella che ho apri la pagina

For Each cella In Range("a1:a3") 'DA MODIFICARE X RANGE AUTOMATICO

Dim oApp
Dim oDocument

Set oApp = CreateObject("InternetExplorer.Application")
oApp.Navigate2 cella.Value 'DA MODIFICARE PER APRIRE I LINK NELLA STESSA FINESTRA CON PIU SCHEDE


Do
    If oApp.readyState = 4 Then '<-- READYSTATE_COMPLETE
        Exit Do
    End If
Loop
oApp.Visible = True
Next


Set oApp = Nothing

End Sub

[luisa227]

OT - Trovo strano che dopo 4 giorni nessuno mi abbia ancora risposto... cè qualcosa che non va? non voglio la pappa pronta, mi basta anche solo un suggerimento per capire se sto facendo giusto o meno.

ora uso questa function per la ricerca dei link... il problema, oltre altri, è che mi trova solo il primo link contenuto in una mail. Se ci sono 2 o piu link mi dà solo il primo.

  Public Function GetText(ByVal OriginalText As String, ByVal TagDiInizio As String, ByVal TagDiFine As String) As String
        On Error Resume Next
        Dim PosDiInizio As Long, PosDiFine As Long, DeltaPos As Long
        
        
        'mio codice
        'verifica = InStr(OriginalText, TagDiInizio)
        'fine mio codice
        'If verifica <> 0 Then
        PosDiInizio = InStr(OriginalText, TagDiInizio) + Len(TagDiInizio)
        
        PosDiFine = InStr(CInt(PosDiInizio), OriginalText, TagDiFine)
       
        DeltaPos = PosDiFine - PosDiInizio
        
        GetText = Mid(OriginalText, PosDiInizio, DeltaPos)
       ' Else
       ' MsgBox "occorrenza non trovata"
       ' End If
    End Function

[luisa227]