Newsgroup: it.comp.appl.access
Titolo: WebBrowser, MSHTML ed Access

Buongiorno.
Ho più o meno completato l'applicativo per il trasferimento in locale della 
posta presente su un server Exchange ed accedibile esclusivamente tramite 
Outlook Web Access.
Invio questo messaggio come documentazione, nel caso possa essere utile a 
qualcun altro. Sarà lungo e, forse, noioso... me ne scuso in anticipo.
La mia situazione è la seguente.
La posta aziendale può essere letta solo con un browser che attivi Outlook 
Web Access (di seguito indicato OWA), che è il programma web per accedere 
alla propria casella di posta elettronica.
Quando si accede ad OWA, dopo aver immesso userid e password, si presenta 
una pagina con alla sinistra le cartelle (posta in arrivo, posta 
indesiderata, posta inviata, etc.) e sulla destra il riepilogo delle 
e-mails.
Facendo click su un rigo della parte destra appena detta (riepilogo), si 
apre il messaggio vero e proprio.
Per poter copiare in un database locale le mails desiderate, ho utilizzato 2 
controlli webbrowser. Ma andiamo per ordine...
Ho una maschera relativa ad una tabella di un database e questa maschera ha 
anche una sottomaschera nella quale vengono mostrati i documenti collegati 
al documento dalla maschera principale.
La maschera è piuttosto complessa, ma i campi che interessano in questa 
parte dell'applicativo sono solo due di tipo textbox: il Titolo e la 
Descrizione. Nel Titolo metterò l'intestazione della mail, mentre nella 
Descrizione il contenuto di tipo text.
Inoltre dovrò creare anche un documento collegato nel quale salverò il 
contenuto della mail in formato html ed un documento per ogni allegato.
Un pulsante mi permette di aprire la maschera relativa all'OWA vero e 
proprio.
Questa seconda maschera ha nella parte corpo solo 2 controlli webbrowser 
(webbrowser1 e webbrowser2), sovrapposti, che occupano quasi l'intero 
schermo. Nella parte alta, invece, ci sono 3 pulsanti: VisualizzaCartelle, 
CopiaMail ed Esci.
Nel modulo con le dichiarative ci sono le seguenti 4 definizioni:
Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
        (ByVal sAgent As String, _
        ByVal IAccessType As Long, _
        ByVal sProxyName As String, _
        ByVal sProxyByPass As String, _
        ByVal IFlags As Long) _
        As Long
Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" 
_
        (ByVal hOpen As Long, _
        ByVal sUrl As String, _
        ByVal sHeaders As String, _
        ByVal ILength As Long, _
        ByVal IFlags As Long, _
        ByVal IContext As Long) _
        As Long
Declare Function InternetReadFile Lib "wininet.dll" _
        (ByVal hFile As Long, _
        ByVal sBuffer As String, _
        ByVal INumBytesToRead As Long, _
        INumberOfBytesRead As Long) _
        As Integer
Declare Function InternetCloseHandle Lib "wininet.dll" _
        (ByVal hInet As Long) _
        As Integer
Ecco il codice della maschera coi 2 webbrowser, con qualche annotazione per 
chiarire meglio il significato di alcuni passaggi.
Option Compare Database
Option Explicit
Dim Mascheraritorno As String, Mascheraaddestramento As Form
Dim Cartella As String, Nomefile As String, Suffisso As String
Dim Cartellalocale As String, Nomefilelocale As String
Dim Nomefile2 As String, Nomefileprec As String
Dim FileHTML As Variant
Dim NodoAttivo As Integer
Dim Buffer As String * 2048
Dim BytesLetti As Long
Dim HandleInternet As Long
Dim HandleHTTP As Long
Dim RispHTML As Boolean
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_FLAG_RELOAD = &H80000000
Dim OggettoWebBrowser1 As SHDocVw.WebBrowser
Dim OggettoWebBrowser2 As SHDocVw.WebBrowser
Dim DocumentoHTML As MSHTML.HTMLDocument
Dim ElementoDelDocumento As MSHTML.HTMLDocument
Dim FrameDelDocumento As MSHTML.HTMLFrameElement
Dim Allegati As MSHTML.HTMLLinkElement
Dim TabellaDelDocumento As MSHTML.HTMLTable
Dim Rigaditabella As MSHTML.HTMLTableRow
Dim CellaDiTabella As MSHTML.HTMLTableCell
Dim Oggettodeldocumento As String, TitoloDellaMail As String
Dim Mittente As String, DettaglioMail As String
Dim Qntallegaticopiati As Integer
Private Sub Form_Open(Cancel As Integer)
'#############################################################################
'#############################  inizio routine 
##############################
'#############################################################################
On Error GoTo errorestandard 
'#####
GoTo dopoerrorestandard 
'#####
errorestandard: Select Case GestioneErrore(Err.Number, Err.Description) 
'#####
Case 1: Resume 
'#####
Case 2: Resume Next 
'#####
Case 3: On Error GoTo 0 
'#####
        Resume 
'#####
Case 4: Resume escidallaroutine 
'#####
End Select 
'#####
escidallaroutine: Exit Sub 
'#####
dopoerrorestandard: 
'#####
'#############################################################################
'##############################  fine routine 
###############################
'#############################################################################
La precedente routine per la gestione generalizzata degli errori viene posta 
all'inizio di tutte le routines eventi gestite dalla maschera. Nelle 
successive routines eventi eviterò di riscriverla, anche se comunque è 
presente in tutte le parti del programma. GestioneErrore è una Function 
scritta in un modulo.
' Dimensioni massime delle finestre con schermo 800 x 600
' (Width = Larghezza    Height = Altezza    1 cm = 567 twip)
'
' Width = 11530     (20,33 cm) se NON è presente la barra per la selezione 
del record
' Width = 11250     (19,84 cm) se è presente la barra per la selezione del 
record
' Height = 7170     (12,65 cm) con rigo menu + 1 rigo di icone soltanto
'
' Se si devono impostare da programma anche Left e Top, impostarli prima di 
Width e Height
' E' necessario che le dimensioni (width ed height) vengano impostate dopo 
della posizione (top e left)
    Me.WebBrowser1.Left = 0
    Me.WebBrowser2.Left = 0
    Me.WebBrowser1.Top = 0
    Me.WebBrowser2.Top = 0
    Me.WebBrowser1.Width = 11530
    Me.WebBrowser2.Width = 11530
    Me.WebBrowser1.Height = 7000
    Me.WebBrowser2.Height = 7000
    Me.Cycle = 1                    ' 0 = Tutti i records   1 = Record 
corrente
    Me.Caption = Titoloapplicazione
' ### Titoloapplicazione viene impostato in un'altra parte del programma
End Sub
Private Sub Form_Load()
' ### Qui ci sono le 11 istruzioni per il richiamo della gestione 
generalizzata dell'errore
    Mascheraritorno = Nz(Me.OpenArgs)
'### la maschera chiamante passa il proprio nome come argomento alla 
maschera chiamata.
    Set Mascheraaddestramento = Forms(Mascheraritorno)
    Me.WebBrowser1.visible = True
    Me.WebBrowser2.visible = False
    Me.VisualizzaCartelle.Enabled = False
    Me.CopiaMail.Enabled = False
    Set OggettoWebBrowser1 = Me.WebBrowser1.object
    Set OggettoWebBrowser2 = Me.WebBrowser2.object
' Col parametro &H1 verrebbe attivata una finestra esterna
' Col parametro &H8 si evita di scrivere nella cache (per motivi di 
sicurezza)
    OggettoWebBrowser1.navigate "
https://sitoaziendale.com
", &H8
    Do While OggettoWebBrowser1.Busy Or _
            OggettoWebBrowser1.readyState < 4
        DoEvents
    Loop
End Sub
Private Sub VisualizzaCartelle_Click()
' ### Qui ci sono le 11 istruzioni per il richiamo della gestione 
generalizzata dell'errore
    Me.WebBrowser1.visible = True
    Me.WebBrowser1.SetFocus
    Me.WebBrowser2.visible = False
    Me.VisualizzaCartelle.Enabled = False
    Me.CopiaMail.Enabled = False
End Sub
Private Sub CopiaMail_Click()
' ### Qui ci sono le 11 istruzioni per il richiamo della gestione 
generalizzata dell'errore
    Do While OggettoWebBrowser2.Busy Or _
            OggettoWebBrowser2.readyState < 4
        DoEvents
    Loop
    Set DocumentoHTML = Me.WebBrowser2.object.Document
    DettaglioMail = ""
    Set TabellaDelDocumento = DocumentoHTML.getElementById("tblHeader")
    Set Rigaditabella = TabellaDelDocumento.Rows(0)
    Set CellaDiTabella = Rigaditabella.Cells(3)
    DettaglioMail = DettaglioMail & "Inviato:    " & 
CellaDiTabella.innerText & vbCrLf
    Set ElementoDelDocumento = DocumentoHTML.getElementById("_trFromText")
    DettaglioMail = DettaglioMail & "Da:          " & 
ElementoDelDocumento.innerText & vbCrLf
    Mittente = ElementoDelDocumento.innerText
    Set ElementoDelDocumento = DocumentoHTML.getElementById("_trToText")
    DettaglioMail = DettaglioMail & "A:            " & 
ElementoDelDocumento.innerText & vbCrLf
    Set ElementoDelDocumento = DocumentoHTML.getElementById("_trCcText")
    DettaglioMail = DettaglioMail & "Cc:           " & 
ElementoDelDocumento.innerText & vbCrLf
    Set ElementoDelDocumento = 
DocumentoHTML.getElementById("_trSubjectText")
    DettaglioMail = DettaglioMail & "Oggetto:   " & 
ElementoDelDocumento.innerText & vbCrLf
    Oggettodeldocumento = ElementoDelDocumento.innerText
    Set ElementoDelDocumento = DocumentoHTML.getElementById("_tdAttachWell")
    DettaglioMail = DettaglioMail & "Allegati:   " & 
ElementoDelDocumento.innerText & vbCrLf
    Set FrameDelDocumento = DocumentoHTML.Frames(0).Document
    DettaglioMail = DettaglioMail & vbCrLf & 
FrameDelDocumento.body.innerText & vbCrLf
    TitoloDellaMail = "[e-mail] " & CellaDiTabella.innerText & " " & _
            Mittente & ": " & Oggettodeldocumento
    Set rst1 = Mascheraaddestramento.RecordsetClone
    TitoloDellaMail = Left$(TitoloDellaMail, rst1.Fields("Titolo").Size)
    Set rst1 = Nothing
    If Not Mascheraaddestramento.NewRecord Then _
            DoCmd.GoToRecord acDataForm, Mascheraaddestramento.Name, 
acNewRec
    Mascheraaddestramento!Titolo = TitoloDellaMail
    Mascheraaddestramento!Descrizione = DettaglioMail
    Mascheraaddestramento!DataAggiornamento = Now
    Saltadataaggiornam = True
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
    Saltadataaggiornam = False
    Nomefile = Generanomefile(Cartellalocale, Nomefilelocale)
    Suffisso = ".htm"
    Nomefileprec = Nomefile & Suffisso
    FileHTML = Nomefile & Suffisso
    Open FileHTML For Output As #1 Len = 2048
    j = Int(Len(FrameDelDocumento.body.innerHTML) / 2048)
    If j * 2048 < Len(FrameDelDocumento.body.innerHTML) Then j = j + 1
    For I = 1 To j
        Print #1, Mid(FrameDelDocumento.body.innerHTML, (I - 1) * 2048 + 1, 
2048);
    Next
    Close #1
    [Forms]![M 0010-0010 Parametri].[Param01] = TitoloDellaMail
    [Forms]![M 0010-0010 Parametri].[Param02] = Nomefile
    [Forms]![M 0010-0010 Parametri].[Param03] = Suffisso
    [Forms]![M 0010-0010 Parametri].[Param04] = Cartellalocale
    [Forms]![M 0010-0010 Parametri].[Param05] = Nomefilelocale
    OLE_Crea Mascheraritorno, "OWA", ".htm"
'### OLE_Crea è una funzione scritta in un modulo e serve a generare il 
record nel database.
    Qntallegaticopiati = 0
    Set Allegati = DocumentoHTML.getElementById("idAttachmentWell")
' Allegati.childnodes(1).nameprop è questo: ScanImage002.jpg?attach=1
' Allegati.childnodes(1).outertext è questo: ScanImage002.jpg?(109KB)?
    If Allegati.HasChildNodes = False Then GoTo dopoallegati
    If Allegati.ChildNodes.Length = 0 Then GoTo dopoallegati
    NodoAttivo = 0
loopsuinodi:
    If Allegati.ChildNodes(NodoAttivo).HasChildNodes = False _
            Then GoTo vaialnodosuccessivo
    If InStr(Allegati.ChildNodes(NodoAttivo).href, "attach=1") = 0 _
            Then GoTo vaialnodosuccessivo
    Nomefile2 = Allegati.ChildNodes(NodoAttivo).nameProp
    If Len(Nomefile2) > 9 Then Nomefile2 = Left$(Nomefile2, Len(Nomefile2) - 
9)
'### Le circa 30 istruzioni successive servono per "normalizzare" il nome 
del file e sostituire i caratteri %20 con degli spazi. Forse esiste qualche 
classe e relativo metodo per farlo automaticamente, ma io non l'ho trovato.
    j = 1
loopnormalizzazione:
    I = InStr(j, Nomefile2, "%")
    If I = 0 Then GoTo doponormalizzazione
    If I + 2 > Len(Nomefile2) Then GoTo doponormalizzazione
    arco1 = Mid$(Nomefile2, I + 1, 2)
    If InStr("0123456789ABCDEF", UCase$(Mid$(arco1, 1, 1))) = 0 Or _
            InStr("0123456789ABCDEF", UCase$(Mid$(arco1, 2, 1))) = 0 Then
        j = I + 1
        GoTo loopnormalizzazione
    End If
    Select Case UCase$(Mid$(arco1, 1, 1))
        Case "0" To "9": m = Val(Mid$(arco1, 1, 1)) * 16
        Case "A":        m = 10 * 16
        Case "B":        m = 11 * 16
        Case "C":        m = 12 * 16
        Case "D":        m = 13 * 16
        Case "E":        m = 14 * 16
        Case "F":        m = 15 * 16
    End Select
    Select Case UCase$(Mid$(arco1, 2, 1))
        Case "0" To "9": n = Val(Mid$(arco1, 2, 1))
        Case "A":        n = 10
        Case "B":        n = 11
        Case "C":        n = 12
        Case "D":        n = 13
        Case "E":        n = 14
        Case "F":        n = 15
    End Select
    arco1 = Chr(m + n)
    Nomefile2 = Left$(Nomefile2, I - 1) & arco1 & _
                Mid$(Nomefile2, I + 3)
    j = I
    GoTo loopnormalizzazione
doponormalizzazione:
    Suffisso = ""
    If Len(Nomefile2) > 4 Then
        Suffisso = LCase$(Right$(Nomefile2, 4))
        Nomefile2 = Left$(Nomefile2, Len(Nomefile2) - 4)
    End If
    If InStr(".doc.dot.xls.xlt.ppt.pps.pdf.zip.jpg.bmp.txt.htm", _
            Suffisso) = 0 Then Suffisso = ".XXX"
loopsunomefile:
    Nomefile = Generanomefile(Cartellalocale, Nomefilelocale)
    FileHTML = Nomefile & Suffisso
    If FileHTML = Nomefileprec Then GoTo loopsunomefile
    Nomefileprec = FileHTML
    HandleInternet = InternetOpen(vbNullString, _
            INTERNET_OPEN_TYPE_PRECONFIG, _
            vbNullString, _
            vbNullString, _
            0)
    If HandleInternet = 0 Then
        MsgBox "Errore nella funzione InternetOpen"
        DoCmd.Close
    End If
    HandleHTTP = InternetOpenUrl(HandleInternet, _
        Allegati.ChildNodes(NodoAttivo).href, _
        vbNullString, _
        0, _
        INTERNET_FLAG_RELOAD, _
        0)
    If HandleHTTP = 0 Then
        MsgBox "Errore nella funzione InternetOpenUrl"
        DoCmd.Close
    End If
' ### Il file da creare viene aperto con lunghezza buffer 1 per evitare che 
si generino files di lunghezza maggiore del file presente sul web.
    Open FileHTML For Output As #1 Len = 1
    Buffer = ""
leggifile:
    RispHTML = InternetReadFile(HandleHTTP, Buffer, Len(Buffer), BytesLetti)
    If RispHTML = True Then
        For I = 1 To BytesLetti
            Print #1, Mid(Buffer, I, 1);
        Next
        If BytesLetti > 0 Then GoTo leggifile
    End If
    Close #1
    If HandleHTTP <> 0 Then InternetCloseHandle (HandleHTTP)
    If HandleInternet <> 0 Then InternetCloseHandle (HandleInternet)
    [Forms]![M 0010-0010 Parametri].[Param01] = "Allegato allla mail: " & _
                Nomefile2
    [Forms]![M 0010-0010 Parametri].[Param02] = Nomefile
    [Forms]![M 0010-0010 Parametri].[Param03] = Suffisso
    [Forms]![M 0010-0010 Parametri].[Param04] = Cartellalocale
    [Forms]![M 0010-0010 Parametri].[Param05] = Nomefilelocale
    OLE_Crea Mascheraritorno, "OWA", ".htm"
    Qntallegaticopiati = Qntallegaticopiati + 1
vaialnodosuccessivo:
    If NodoAttivo < Allegati.ChildNodes.Length - 1 Then
        NodoAttivo = NodoAttivo + 1
        GoTo loopsuinodi
    End If
dopoallegati:
    Me.VisualizzaCartelle.Enabled = True
    Me.Esci.SetFocus
    Me.CopiaMail.Enabled = False
    MsgBox "Copiata la mail e " & Qntallegaticopiati & " allegati", , _
            Titoloapplicazione
End Sub
Private Sub Esci_Click()
' ### Qui ci sono le 11 istruzioni per il richiamo della gestione 
generalizzata dell'errore
    DoCmd.Close
End Sub
Private Sub WebBrowser1_navigateerror(ByVal pDisp As Object, url, frame, 
statuscode, Cancel As Boolean)
' ### Qui ci sono le 11 istruzioni per il richiamo della gestione 
generalizzata dell'errore
    MsgBox "Errore nel tentativo di collegarsi all'indirizzo" & vbCrLf & url
    DoCmd.Close
End Sub
Private Sub WebBrowser2_navigateerror(ByVal pDisp As Object, url, frame, 
statuscode, Cancel As Boolean)
' ### Qui ci sono le 11 istruzioni per il richiamo della gestione 
generalizzata dell'errore
    MsgBox "Errore nel tentativo di collegarsi all'indirizzo" & vbCrLf & url
    DoCmd.Close
End Sub
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
' ### Qui ci sono le 11 istruzioni per il richiamo della gestione 
generalizzata dell'errore
' Questa istruzione evita di far aprire una finestra browser esterna
    Set ppDisp = Me.WebBrowser2.object
    Me.WebBrowser2.visible = True
    Me.WebBrowser2.SetFocus
    Me.WebBrowser1.visible = False
    Me.VisualizzaCartelle.Enabled = True
    Me.CopiaMail.Enabled = True
End Sub
Private Sub WebBrowser2_NewWindow2(ppDisp As Object, Cancel As Boolean)
' ### Qui ci sono le 11 istruzioni per il richiamo della gestione 
generalizzata dell'errore
    Cancel = True
'### La precedente istruzione evita che questa applicazione possa essere 
utilizzata come un browser per navigare in Internet. In pratica, qundo si 
visualizza un messaggio, si può solo tornare indietro o sceglire di copiarlo 
in locale.
End Sub
E' tutto.
Spero di avere eliminato tutti i riferimenti dell'azienda... se no mi 
ammazzano.
Un grazie particolare a Sergio e Cinzia che mi hanno dato importantissimi 
consigli per la realizzazione di questa applicazione.
Saluti a tutti e Buon Anno
Antonio

 Antonio
Buon anno anche a te e a tutto il NG!
-- 
Cinzia
---------------------------------------
|  
http://www.riolab.org
  |
---------------------------------------

 Antonio
Mi associo anch'io ai saluti di Cinzia...
Ciao e buona fine e buon inizio.
-- 
Sergio MAZZA