Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

leggere gmail inbox senza Outlook

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Re: leggere gmail inbox senza Outlook

Postdi Anthony47 » 17/09/19 19:09

Allora...
1) Lavorando nel browser e' possibile inserire l'autenticazione direttamente nella stringa url; esempio:
https://utente1%40gmail.com:PASSWORD1@m ... /feed/atom
(e' necessario simulare la prima @ con la stringa %40, altrimenti non funziona; notate anche l'uso di /a/ invece che /0/, /1/, etc)

La stessa tecnica usata nella Request invece non e' accettata

2) Abilitando le app meno sicure sono stato in grado di accedere a tutti gli accounts; peccato che inizialmente non fossi in grado di revocare una autorizzazione, quindi dopo aver autorizzato un utente non ero in grado di passare a un altro utente se non riavviando il pc.

3) Cercando come fare, mi sono imbattuto in questo articolo:
https://officetricks.com/excel-vba-clear-cache-ie/
Excel VBA Clear Cache – IE browser and xmlhttp requests

Il metodo che lancia RunDll32.exe tramite Shell non ha funzionato; ha invece funzionato il metodo che usa la Function InternetSetOptionStr. Quando dico "ha funzionato" intendo che l'autorizzazione data viene cancellata ed e' necessario, col mio codice, reintrodurre nuovo utente e nuova password.

Pertanto, nel file reperibile al solito link, ho inserito due macro:
Sub NUGMailParse (Nuovo Utente)
Sub GmailParse (e' la vecchia XMLParseGMail; lavora con l'autorizzazione esistente, if any)

In pratica:
-lanciate la Sub NUGMailParse se volete reimpostare l'utente
-lanciate la Sub GmailParse per il refresh del vecchio account

Notate che la macro NON azzera il contenuto del foglio prima di importare i nuovi dati (che quindi finiscono in coda ai precedenti); potrebbe essere utile inserire un Clear in testa alla GmailParse

Per i posteri, il codice delle due macro:
Codice: Seleziona tutto
'RIGOROSAMENTE IN TESTA AL MODULO:
Declare Function InternetSetOptionStr Lib "wininet.dll" Alias "InternetSetOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As Integer


Sub NUGMailParse()                                 'Imposta Account e Password
InternetSetOptionStr 0, 42, sBuf, 0
Call GmailParse
End Sub



Codice: Seleziona tutto
Sub GmailParse()                        'Legge l'account correntemente autorizzato
'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
'Call Clear_Cache
'VBA.Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 11", vbHide

MsgBox ("Completata importazione")
End Sub


Sub myWait(myStab As Single)
Dim myStTiM As Single
'
    myStTiM = Timer
    Do          'wait myStab
        DoEvents
        If Timer > myStTiM + myStab Or Timer < myStTiM Then Exit Do
    Loop
End Sub


Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17053
Iscritto il: 21/03/06 16:03
Località: Ivrea

Sponsor
 

Re: leggere gmail inbox senza Outlook

Postdi patel » 17/09/19 20:33

Ottimo lavoro Anthony, non avevo dubbi che ci saresti riuscito
patel
Utente Senior
 
Post: 309
Iscritto il: 24/04/12 16:03

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "leggere gmail inbox senza Outlook":

Messaggi strani su Outlook
Autore: Gigi38
Forum: Discussioni
Risposte: 6

Chi c’è in linea

Visitano il forum: Nessuno e 42 ospiti