E' possibile con excel ? sono in grado di spedire email ma non di leggerle.
un modo potrebbe essere questo https://developers.google.com/gmail/gmail_inbox_feed ma non sono capace di estrarre i dati
Moderatori: Anthony47, Flash30005
Eh he, io sono fedele al motto che quando non si sa cosa dire e' meglio tacere... Anzi ero rimasto in attesa di un tuo "eureka!"come mai nessuna risposta ?
<feed version="0.3"><title>Gmail - Inbox for pippo@gmail.com</title><tagline>New messages in your Gmail Inbox</tagline><fullcount>5</fullcount><link rel="alternate" href="https://mail.google.com/mail/u/1" type="text/html"/><modified>2019-09-11T15:08:03Z</modified><entry><title>5€ di sconto su Just Eat con PayPal</title><summary>Pippo – Ordina il pranzo o la cena online e risparmia Vedi online IL BELLO È PRENDERCI GUSTO IL BELLO È PRENDERCI GUSTO Il bello di Just Eat è… ordinare quello che vuoi, quando vuoi! Pizza,</summary><link rel="alternate" href="https://mail.google.com/mail/u/1?account_id=PIPPO@gmail.com&message_id=16d209208faec25d&view=conv&extsrc=atom" type="text/html"/><modified>2019-09-11T13:45:04Z</modified><issued>2019-09-11T13:45:04Z</issued><id>tag:gmail.google.com,2004:1644386849397850717</id><author><name>PayPal</name><email>paypal@mail.paypal.it</email></author></entry><entry><title>Ehi, ci sono punti EXTRA che aspettano solo te ></title><summary>Usa i coupon PAYBACK Adventure! Se non visualizzi correttamente questo messaggio, clicca qui Aggiungi newsletter@payback.it ai tuoi contatti Scarica l'APP Ciao Pippo Nr. Carta 12345 - 111</summary><link rel="alternate" href="https://mail.google.com/mail/u/1?account_id=pippo@gmail.com&message_id=16d203245946dbec&view=conv&extsrc=atom" type="text/html"/><modified>2019-09-11T12:00:28Z</modified><issued>2019-09-11T12:00:28Z</issued><id>tag:gmail.google.com,2004:1644380268595174380</id><author><name>PAYBACK per Pippo</name><email>newsletter@payback.it</email></author></entry><entry><title> Vedi il messaggio di Lori e altre notifiche che non hai visto</title><summary>Sono successe molte cose su Facebook dall'ultima volta che hai effettuato l'accesso. Ecco alcune notifiche relative ai tuoi amici che ti sei perso. Grazia 2 messaggi 16 aggiornamenti di</summary><link rel="alternate" href="https://mail.google.com/mail/u/1?account_id=pippo@gmail.com&message_id=16d1c1f2aaa88dea&view=conv&extsrc=atom" type="text/html"/><modified>2019-09-10T17:01:07Z</modified><issued>2019-09-10T17:01:07Z</issued><id>tag:gmail.google.com,2004:1644308586956361194</id><author><name>Facebook</name><email>notification@facebookmail.com</email></author></entry><entry><title>Paolo ha pubblicato qualcosa in QUELLI CHE IN CACIAIA....</title><summary>Paolo ha condiviso una foto in QUELLI CHE IN CACIAIA.... 9 settembre alle ore 22:34 Ieri mattina ore 7.00 ad Antignano Mi piace Commenta Condividi Facebook Paolo ha condiviso una foto</summary><link rel="alternate" href="https://mail.google.com/mail/u/1?account_id=pippo@gmail.com&message_id=16d17bc47e41db69&view=conv&extsrc=atom" type="text/html"/><modified>2019-09-09T20:34:37Z</modified><issued>2019-09-
<feed version="0.3"><title>Gmail - Inbox for pippo@gmail.com</title><tagline>New messages in your Gmail Inbox</tagline><fullcount>3</fullcount><link rel="alternate" href="https://mail.google.com/mail/u/1" type="text/html"/><modified>2019-09-11T15:37:27Z</modified><entry><title>Ehi, ci sono punti EXTRA che aspettano solo te ></title><summary>Usa i coupon PAYBACK Adventure! Se non visualizzi correttamente questo messaggio, clicca qui Aggiungi newsletter@payback.it ai tuoi contatti Scarica l'APP Ciao pippo Nr. Carta 12345 - 108</summary><link rel="alternate" href="https://mail.google.com/mail/u/1?account_id=pippo@gmail.com&message_id=16d203245946dbec&view=conv&extsrc=atom" type="text/html"/><modified>2019-09-11T12:00:28Z</modified><issued>2019-09-11T12:00:28Z</issued><id>tag:gmail.google.com,2004:1644380268595174380</id><author><name>PAYBACK per Andrea</name><email>newsletter@payback.it</email></author></entry><entry><title> Vedi il messaggio di Lori e altre notifiche che non hai visto</title><summary>Sono successe molte cose su Facebook dall'ultima volta che hai effettuato l'accesso. Ecco alcune notifiche relative ai tuoi amici che ti sei perso. Grazia 2 messaggi 16 aggiornamenti di</summary><link rel="alternate" href="https://mail.google.com/mail/u/1?account_id=pippo@gmail.com&message_id=16d1c1f2aaa88dea&view=conv&extsrc=atom" type="text/html"/><modified>2019-09-10T17:01:07Z</modified><issued>2019-09-10T17:01:07Z</issued><id>tag:gmail.google.com,2004:1644308586956361194</id><author><name>Facebook</name><email>notification@facebookmail.com</email></author></entry><entry><title>Paolo ha pubblicato qualcosa in QUELLI CHE IN CACIAIA....</title><summary>Paolo ha condiviso una foto in QUELLI CHE IN CACIAIA.... 9 settembre alle ore 22:34 Ieri mattina ore 7.00 ad Antignano Mi piace Commenta Condividi Facebook Paolo ha condiviso una foto</summary><link rel="alternate" href="https://mail.google.com/mail/u/1?account_id=pippo@gmail.com&message_id=16d17bc47e41db69&view=conv&extsrc=atom" type="text/html"/><modified>2019-09-09T20:34:37Z</modified><issued>2019-09-09T20:34:37Z</issued><id>tag:gmail.google.com,2004:1644231422828993385</id><author><name>Facebook</name><email>notification@facebookmail.com</email></author></entry></feed>
<link rel="alternate" href="https://mail.google.com/mail/u/0?account_id=PIPPO123@gmail.com&message_id=16d3333e541d1471&view=conv&extsrc=atom" type="text/html"/>
Sub XMLParseGMail()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110777
'Derivata da http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110596
' ..........................................................................
' >>>>> Richiede il riferimento alla libreria Microsoft XML <<<<<<
' in Menu /Strumenti /Riferimenti, cercare "Microsoft XML V.xx" e Spuntarla
' ..........................................................................
'
Dim MasterN As String, mySplit, myNext As Long
Dim xmlDoc As Object, I As Long
Dim cNCnt As Long, CipCiop As Object
Dim Request As New XMLHTTP30
Dim myRic As String
MasterN = "//feed" '<<< Nodo principale
'
Set xmlDoc = New MSXML2.DOMDocument
'
myRic = "https://mail.google.com/mail/u/0/feed/atom"
Request.Open "GET", myRic
Request.send
Do Until Request.readyState = 4
Debug.Print Timer, Request.readyState
DoEvents
Loop
xmlDoc.LoadXML Request.responseText
Dim Cioppa As String, lrPos As Long, eTagPos As Long
'Operazioni di pulizia del file xml:
Cioppa = Request.responseXML.XML
Cioppa = Replace(Cioppa, "<entry>", Chr(10) & "<entry>", , , vbTextCompare)
'Cioppa = Replace(Cioppa, " version=""0.3"" xmlns=""http://purl.org/atom/ns#""", "", , , vbTextCompare) 'inutile
Do
'elimina "<link "
lrPos = InStr(1, Cioppa, "<link ", vbTextCompare)
If lrPos = 0 Then Exit Do
eTagPos = InStr(lrPos, Cioppa, "/>", vbTextCompare)
If eTagPos > lrPos Then
Debug.Print Mid(Cioppa, lrPos, eTagPos - lrPos + 2)
Cioppa = Replace(Cioppa, Mid(Cioppa, lrPos, eTagPos - lrPos + 2), "", , , vbTextCompare)
End If
DoEvents
Loop
'
'prima posizione libera nel foglio:
On Error Resume Next
myNext = 0
myNext = Range("A1:AZ10000").Find(What:="*", After:=Range("A1"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
On Error GoTo 0
myNext = myNext + 1
'
xmlDoc.LoadXML (Cioppa) 'Carica xmlDoc
For I = 1 To Cells(1, Columns.Count).End(xlToLeft).Column 'per ogni intestazione colonna
For cNCnt = 0 To 1000
If InStr(1, Cells(1, I).Value, "#", vbTextCompare) <> 0 Then 'Verifica se "attributo"
mySplit = Split("/" & Cells(1, I).Value, "#", , vbTextCompare) 'Gestion Attributo
If UBound(mySplit) > 0 Then
If Len(mySplit(0)) < 3 Then mySplit(0) = ""
Set CipCiop = Nothing
On Error Resume Next
Set CipCiop = xmlDoc.SelectNodes(MasterN & mySplit(0))(cNCnt).Attributes.getNamedItem(mySplit(1))
On Error GoTo 0
If Not CipCiop Is Nothing Then
Cells(myNext + cNCnt, I) = xmlDoc.SelectNodes(MasterN & mySplit(0))(cNCnt).Attributes.getNamedItem(mySplit(1)).Text
End If
Debug.Print MasterN & mySplit(0) & "#" & mySplit(1), cNCnt, Cells(myNext + cNCnt, I)
End If
Else 'Gestion ItemText
Set CipCiop = Nothing
On Error Resume Next
Set CipCiop = xmlDoc.SelectNodes(MasterN & "/" & Cells(1, I).Value)(cNCnt)
On Error GoTo 0
If Not CipCiop Is Nothing Then
Cells(myNext + cNCnt, I) = xmlDoc.SelectNodes(MasterN & "/" & Cells(1, I).Value)(cNCnt).Text
End If
Debug.Print MasterN & "/" & Cells(1, I).Value, cNCnt, Left(Cells(myNext + cNCnt, I), 80)
End If
If CipCiop Is Nothing Then Exit For
Next cNCnt
DoEvents
Next I
'Fine:
Set xmlDoc = Nothing
MsgBox ("Completata importazione")
End Sub
DoEvents
Next I
Debug.Print ">>>>...."
Debug.Print Cioppa
Debug.Print "....<<<<"
'Fine:
Set xmlDoc = Nothing
45303,05 1
45303,05 1
45303,05 1
45303,05 1
45303,05 1
45303,05 1
45303,06 1
45303,06 1
45303,06 1
45303,06 1
45303,06 1
45303,06 1
45303,06 1
45303,06 1
45303,07 1
45303,07 1
45303,07 1
45303,07 1
45303,07 1
45303,07 1
45303,07 1
45303,07 1
45303,07 1
45303,07 1
45303,07 1
45303,08 1
45303,08 1
45303,09 1
45303,09 1
45303,09 1
45303,09 1
45303,09 1
45303,09 1
45303,09 1
45303,09 1
45303,09 1
45303,09 1
45303,09 1
45303,09 1
45303,1 1
45303,1 1
45303,1 1
45303,1 1
45303,1 1
45303,1 1
45303,11 1
45303,11 1
45303,11 1
45303,11 1
45303,11 1
45303,11 1
45303,11 1
45303,11 1
45303,11 1
45303,12 1
45303,12 1
45303,12 1
45303,12 1
45303,12 1
45303,12 1
45303,12 1
45303,13 1
45303,13 1
45303,13 1
45303,13 1
45303,13 1
45303,13 1
45303,13 1
45303,13 1
45303,14 1
45303,14 1
45303,14 1
45303,14 1
45303,14 1
45303,14 1
45303,14 1
45303,14 1
45303,14 1
45303,14 1
45303,14 1
45307,06 1
45307,06 1
45307,06 1
45307,06 1
45307,06 1
45307,07 1
45307,07 1
45307,07 1
45307,07 1
45307,07 1
45307,07 1
45307,07 1
45307,07 1
45307,07 1
45307,07 1
45307,08 1
45307,08 1
45307,08 1
45307,09 1
45307,09 1
45307,09 1
45307,09 1
45307,09 1
45307,09 1
45307,09 1
45307,09 1
45307,09 1
45307,1 1
45307,1 1
45307,1 1
45307,1 1
45307,1 1
45307,1 1
45307,1 1
45307,11 1
45307,11 1
45307,11 1
45307,11 1
45307,11 1
45307,11 1
45307,11 1
45307,11 1
45307,11 1
45307,11 1
45307,12 1
45307,12 1
45307,12 1
45307,12 1
45307,12 1
45307,12 1
45307,12 1
45307,12 1
45307,13 1
45307,13 1
45307,13 1
45307,13 1
45307,13 1
45307,13 1
45307,14 1
45307,14 1
45307,14 1
45307,14 1
45307,14 1
45307,14 1
45307,14 1
45307,14 1
45307,14 1
45307,14 1
45307,14 1
45307,14 1
45307,15 1
45307,15 1
45307,15 1
45307,15 1
45307,15 1
45307,16 1
45307,16 1
45307,16 1
45307,16 1
45307,16 1
45307,16 1
45307,16 1
45307,16 1
45307,16 1
45307,17 1
45307,17 1
45307,17 1
45307,17 1
45307,17 1
45307,17 1
45307,18 1
45307,18 1
45307,18 1
45307,18 1
45307,18 1
45307,18 1
45307,18 1
45307,18 1
45307,19 1
45307,19 1
45307,19 1
45307,19 1
45307,19 1
45307,19 1
45307,19 1
45307,19 1
45307,19 1
45307,2 1
45307,2 1
45307,2 1
45307,2 1
//feed/entry/title 0
//feed/entry/summary 0
//feed/entry/author/email 0
//feed/entry/issued 0
//feed/entry/link#href 0
>>>>....
....<<<<
"https://mail.google.com/mail/u/0/feed/atom"
Sub XMLParseGMail()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110777
'Derivata da http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110596
' ..........................................................................
' >>>>> Richiede il riferimento alla libreria Microsoft XML <<<<<<
' in Menu /Strumenti /Riferimenti, cercare "Microsoft XML V.xx" e Spuntarla
' ..........................................................................
'
Dim MasterN As String, mySplit, myNext As Long
Dim xmlDoc As Object, I As Long
Dim cNCnt As Long, CipCiop As Object, myTim As Single
'Dim Request As New XMLHTTP30
Dim Request As XMLHTTP30
Dim myRic As String
MasterN = "//feed" '<<< Nodo principale
'
Set Request = New XMLHTTP30
Set xmlDoc = New MSXML2.DOMDocument
'
Debug.Print ">>>> GO >>> ", Format(Now, "hh:mm:ss")
myTim = Timer
myRic = "https://mail.google.com/mail/u/0/feed/atom"
Request.Open "GET", myRic
Request.send
'
Do Until Request.readyState = 4
If Timer > (myTim + 60) Or Timer < myTim Then Exit Do
Debug.Print "Do loop: ", myTim, Format(Timer - myTim, "0.00"), Request.readyState
DoEvents
myWait (0.2)
Loop
Debug.Print "End Do: ", myTim, Format(Timer - myTim, "0.00"), Request.readyState
'xmlDoc.LoadXML Request.responseText
Debug.Print ">>>ResponseText..." & Left(Request.responseText, 500) & "...<<<"
Dim Cioppa As String, lrPos As Long, eTagPos As Long
'Operazioni di pulizia del file xml:
Cioppa = Request.responseXML.XML
Cioppa = Replace(Cioppa, "<entry>", Chr(10) & "<entry>", , , vbTextCompare)
'Cioppa = Replace(Cioppa, " version=""0.3"" xmlns=""http://purl.org/atom/ns#""", "", , , vbTextCompare) 'inutile
Debug.Print "Cleaning >>>..."
Do
'elimina "<link "
lrPos = InStr(1, Cioppa, "<link ", vbTextCompare)
If lrPos = 0 Then Exit Do
eTagPos = InStr(lrPos, Cioppa, "/>", vbTextCompare)
If eTagPos > lrPos Then
Debug.Print Mid(Cioppa, lrPos, eTagPos - lrPos + 2)
Cioppa = Replace(Cioppa, Mid(Cioppa, lrPos, eTagPos - lrPos + 2), "", , , vbTextCompare)
End If
DoEvents
Loop
Debug.Print "...<<< Cleaned"
Debug.Print ">>>CioppaCleaned.." & Left(Cioppa, 500) & "...<<<"
'
'prima posizione libera nel foglio:
On Error Resume Next
myNext = 0
myNext = Range("A1:AZ10000").Find(What:="*", After:=Range("A1"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
On Error GoTo 0
myNext = myNext + 1
'
xmlDoc.LoadXML (Cioppa) 'Carica xmlDoc
For I = 1 To Cells(1, Columns.Count).End(xlToLeft).Column 'per ogni intestazione colonna
Debug.Print ">Importing nodes: " & Cells(1, I).Value
For cNCnt = 0 To 1000
If InStr(1, Cells(1, I).Value, "#", vbTextCompare) <> 0 Then 'Verifica se "attributo"
mySplit = Split("/" & Cells(1, I).Value, "#", , vbTextCompare) 'Gestion Attributo
If UBound(mySplit) > 0 Then
If Len(mySplit(0)) < 3 Then mySplit(0) = ""
Set CipCiop = Nothing
On Error Resume Next
Set CipCiop = xmlDoc.SelectNodes(MasterN & mySplit(0))(cNCnt).Attributes.getNamedItem(mySplit(1))
On Error GoTo 0
If Not CipCiop Is Nothing Then
Cells(myNext + cNCnt, I) = xmlDoc.SelectNodes(MasterN & mySplit(0))(cNCnt).Attributes.getNamedItem(mySplit(1)).Text
End If
Debug.Print MasterN & mySplit(0) & "#" & mySplit(1), cNCnt, Cells(myNext + cNCnt, I)
End If
Else 'Gestion ItemText
Set CipCiop = Nothing
On Error Resume Next
Set CipCiop = xmlDoc.SelectNodes(MasterN & "/" & Cells(1, I).Value)(cNCnt)
On Error GoTo 0
If Not CipCiop Is Nothing Then
Cells(myNext + cNCnt, I) = xmlDoc.SelectNodes(MasterN & "/" & Cells(1, I).Value)(cNCnt).Text
End If
Debug.Print MasterN & "/" & Cells(1, I).Value, cNCnt, Left(Cells(myNext + cNCnt, I), 80)
End If
If CipCiop Is Nothing Then Exit For
Next cNCnt
DoEvents
Next I
'Fine:
Debug.Print Format(Timer - myTim, "0.00"), "<<<< END"
Set xmlDoc = Nothing
MsgBox ("Completata importazione")
End Sub
Bingo!Potrebbe dipendere dal fatto che sullo stesso pc ho 4 account Gmail?
<HEAD>
<TITLE>Unauthorized</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF" TEXT="#000000">
<H1>Unauthorized</H1>
<H2>Error 401</H2>
</BODY>
</HTML>
Torna a Applicazioni Office Windows
Problemi di ricezione Mail su outlook Autore: danibi60 |
Forum: Applicazioni Office Windows Risposte: 2 |
Problema con copia dati senza formattazione Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 9 |
EXCEL - Estrazione nome file senza estensione da percorso Autore: Dylan666 |
Forum: Applicazioni Office Windows Risposte: 6 |
Visitano il forum: Nessuno e 22 ospiti