[VBA] Passare variabili da Access a Outlook

**ibernet** · 19-09-2011, 08:53

Sto passato da office 2003 32bit a office 2010 a 64bit.

Ho una funzione che sia tramite access che excel invia una mail in modo automatico utilizzando outlook.

Passando alla versione 2010 64bit sto riscontrando un problema che non riesco a capire..

Vi passo il codice:
Funzione1 in access, valorizzo le variabili da trasportare in outlook, questa parte è OK.

codice:

Public Function invio_mail()

Dim blnSuccessful As Boolean
Dim strHTML As String
Dim StyleO As String
Dim CHIUDI As String
Dim Style1 As String
Dim Style1R As String
Dim Style2 As String
Dim Style2R As String
Dim Inviato_a As String
Dim Oggetto As String
Dim Allegato As String
Dim in_copia As String
Dim in_copia_nascosta As String

' Apro il tag per compilare gli Stili
StyleO = "<style type=" & """text/css""" & ">"
CHIUDI = "</span>"

' CREO 2 STILI DI TESTO CHE RICHIAMO NEL CSS DELL'HTML
Style1 = ".stile1{font-family:" & """Trebuchet ms""" & ",arial;font-size:1.0em;color:#000;}" ' TIPO STILE
Style1R = "<span class=" & """stile1""" & ">"
Style2 = ".stile2{font-family:" & """Trebuchet ms""" & ",arial;font-size:1.0em;color:#3C9;}" ' TIPO STILE
Style2R = "<span class=" & """stile2""" & ">"

' SCRIVO IL MESSAGGIO DA INVIARE VIA EMAIL TRAMITE HTML
strHTML = "<html><head>" & StyleO & Style1 & Style2 & "</style></head>" & _
            "<body>" & _
              Style1R & "Contenuto della mail" & CHIUDI & _
            "</body></html>"

Inviato_a = "mail@dominio.com"
Oggetto = "Oggetto mail"
Allegato = ""
in_copia = ""
in_copia_nascosta = ""

blnSuccessful = FnSafeSendEmail(Inviato_a, Oggetto, strHTML, Allegato, in_copia, in_copia_nascosta)

End Function

Funzione2 in access, da qui verifico che il visual basic di outlook sia aperto e passo i parametri alla funzione contenente in esso..

codice:

Public Function FnSafeSendEmail(strTo As String, _
                    strSubject As String, _
                    strMessageBody As String, _
                    Optional strAttachmentPaths As String, _
                    Optional strCC As String, _
                    Optional strBCC As String) As Boolean


    Dim objOutlook As Object   
    Dim objNameSpace As Object  
    Dim objExplorer As Object
    Dim blnSuccessful As Boolean
    Dim blnNewInstance As Boolean

    ' VERIFICO SE IL COMPILATORE DI OUTLOOK E' GIA' APERTO
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0

    ' SE OUTLOOK è CHIUSO LO APRO e creo una nuova istanza
    If objOutlook Is Nothing Then
        'Outlook non è già in esecuzione - creare una nuova istanza ...
        Set objOutlook = CreateObject("Outlook.Application")
        blnNewInstance = True

        'CREO un'istanza di ambiente di Visual Basic ..
        Set objNameSpace = objOutlook.GetNamespace("MAPI")
        Set objExplorer = objOutlook.Explorers.Add(objNameSpace.Folders(1), 0)
        objExplorer.CommandBars.FindControl(, 1695).Execute
        objExplorer.Close
        Set objNameSpace = Nothing
        Set objExplorer = Nothing

    End If

    ' AVVIO LA FUNZIONE INTERNA A OUTLOOK PER L'INVIO DELLA E-MAIL
    blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, strSubject, strMessageBody, strAttachmentPaths)

    ' CHIUDO TUTTO
    If blnNewInstance = True Then objOutlook.Quit
    Set objOutlook = Nothing
    FnSafeSendEmail = blnSuccessful

End Function

E' qui che si presenta il problema..
quando il codice esegue questa istruzione Set objOutlook = GetObject(, "Outlook.Application") rileva correttamente outlook ma quando tento di passare il codice da access a outlook tramite questa stringa: blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, strSubject, strMessageBody, strAttachmentPaths) mi esce questo errore (Proprietà o metodo non supportati dall'oggetto)

Funzione presente in outlook:

codice:

Public Function FnSendMailSafe(strTo As String, _
                                strCC As String, _
                                strBCC As String, _
                                strSubject As String, _
                                strMessageBody As String, _
                                Optional strAttachments As String) As Boolean

On Error GoTo ErrorHandler:

    Dim MAPISession As Outlook.NameSpace
    Dim MAPIFolder As Outlook.MAPIFolder
    Dim MAPIMailItem As Outlook.MailItem
    Dim oRecipient As Outlook.Recipient
    Dim TempArray() As String
    Dim varArrayItem As Variant
    Dim strEmailAddress As String
    Dim strAttachmentPath As String
    Dim blnSuccessful As Boolean

da qui continua il codice che invia la mail....

- Per far funzionare il codice bisogna settare il livello di protezione della macro a LOW, già settato ma niente..
- Il codice lo devo utilizzare su Windows server 2008 64bit con office 2010 64bit, ho fatto un test anche sul seven a 64bit ma rilevo lo stesso problema..
- Non ho ancora avuto modo di fare un test con versioni a 32bit

Qualcuno è già incappato in questo problema o sa darmi qualche dritta per risolvere?

Grazie a tutti per l'attenzione

**ibernet** · 19-09-2011, 19:31

A tentativi mi sono accorto di una cosa
questa riga di comando che dovrebbe aprire outlook non funziona, ma la cosa strana è che se al posto di outlook ci scrivo excel access o word va benissimo

Set LanciaOutlook = CreateObject("Outlook.Application")
LanciaOutlook.Visible = True

Mi viene da pensare che l'activeX sia buggato o che il richiamo di outlook 2010 si faccia in modo diverso...

Qualcuno di voi ha qualche idea?

Grazie

**ibernet** · 22-09-2011, 10:31

Ragazzi, ho provato di tutto girato 1000 siti ma non ne esco...
Per aggirare il problema o si manda una e-mail in formato testo tramite questo script:
Se volete andare a capo nel body usate VbCrlf

codice:

Private Sub SendMail_Click()
' Access 2010, Outlook 2003, References:
' Visual Basic for Applications
' Microsoft Access 14.0 Object Library
' Microsoft Outlook 14.0 Object Library
'
Dim NewMail As MailItem, AttachArray(1 To 1) As String, i As Integer

Set NewMail = CreateObject("Outlook.application.14").CreateItem(olMailItem)
AttachArray(1) = "k:\Prova.txt"

With NewMail
.To = "nome@dominio.com"
.Subject = "Email da Access 2010 64bit"
.Body = "Access 2010 64bit, bit, bit, ...." & VbCrlf & "ora sono nella seconda riga"
.CC = "nome@dominio.com"
For i = 1 To 1
.Attachments.Add AttachArray(i)
Next
.Send
End With

End Sub

Se invece volete per forza mantenere il formato in html si mette su outlook 2003 virtualizzato, opzione che ho applicato e che funziona.

Ora apro un ticket verso la microsoft se mi danno qualche soluzione ve la riporto..

Grazie a tutti per l'attenzione

**ibernet** · 01-03-2012, 15:29

Faccio un UP, sperando che passi qualcuno che ne capisce e mi sappia aiutare..
Non sono ancora riuscito a trovare la soluzione e al momento sto utilizzando un outlook 2003 virtualizzato.
Grazie

**ibernet** · 19-04-2012, 13:08

SOLUZIONE:
Vi metterei l'allegato ma il forum non lo permette..
Testato su Excel ed Access
Spero possa evitare ad altri lo sbattimento che ho avuto io per trovare una soluzione ottimale
Per il clic automatico sul SI utilizzate ClicYes, le mail possono essere mandate anche simultaneamente! Il codice è molto performante e potente.

Riferimenti da aggiungere:
Visual Basic For Applications
Microsoft Access 14.0 Object Library
OLE Automation
Microsoft Office 14.0 Access database engine Object
Microsoft Outlook 14.0 Object Library
Microsoft Scripting Runtime

codice:

Option Compare Database
Option Explicit
' To work properly outlook must be open, it must have automatic
' macro activation (low protection level) and the Visual Basic, Applications open



' This first function values all needed information to fill the email
' It allows then to transfer the values in HTML format to outlook
Public Function invio_mail()

Dim blnSuccessful As Boolean
Dim strHTML As String
Dim StyleO As String
Dim CHIUDI As String
Dim Style1 As String
Dim Style1R As String
Dim Style2 As String
Dim Style2R As String
Dim Inviato_a As String
Dim Oggetto As String
Dim Allegato As String
Dim in_copia As String
Dim in_copia_nascosta As String

' Open the tag for ccs Style
StyleO = "<style type=" & """text/css""" & ">"
CHIUDI = "</span>"

' Make Two Style for HTML
Style1 = ".stile1{font-family:" & """Trebuchet ms""" & ",arial;font-size:1.0em;color:#000;}" ' TIPO STILE
Style1R = "<span class=" & """stile1""" & ">"
Style2 = ".stile2{font-family:" & """Trebuchet ms""" & ",arial;font-size:1.0em;color:#3C9;}" ' TIPO STILE
Style2R = "<span class=" & """stile2""" & ">"

' Message for E-mail (format HTML)
strHTML = "<html><head>" & StyleO & Style1 & Style2 & "</style></head>" & _
            "<body>" & _
              Style1R & "Test Message" & CHIUDI & _
            "</body></html>"

Inviato_a = "xxxx@dominio.com" 'Send to
Oggetto = "Access Test Macro" 'Subjects
Allegato = "C:\Users\a-dabarr\Documents\Error Connecting.JPG" 'Attacment
in_copia = "xxxx@dominio.biz" 'CC
in_copia_nascosta = "" 'CCn

blnSuccessful = FnSafeSendEmail(Inviato_a, Oggetto, strHTML, True, Allegato, in_copia, in_copia_nascosta)

End Function


Public Function FnSafeSendEmail(strTo As String, _
                    strSubject As String, _
                    strMessageBody As String, _
                    Optional bBodyIsHTML As Boolean = False, _
                    Optional strAttachmentPaths As String, _
                    Optional strCC As String, _
                    Optional strBCC As String) As Boolean

    FnSafeSendEmail = False
    
    Dim oOutlook As New Outlook.Application ' This will get a reference to Outlook, opening it if necessary
    
    ' Create the message
    Dim oMessage As Outlook.MailItem
    Set oMessage = oOutlook.CreateItem(olMailItem)
    
    ' Add the message recipients
    AddRecipients oMessage, strTo, Outlook.olTo
    AddRecipients oMessage, strCC, Outlook.olCC
    AddRecipients oMessage, strBCC, Outlook.olBCC
    
    ' Set the message subject
    oMessage.Subject = strSubject
    
    ' Add the message body
    If bBodyIsHTML Then
        oMessage.HTMLBody = strMessageBody
    Else
        oMessage.Body = strMessageBody
    End If
    
    ' Add message attachments
    AddAttachments oMessage, strAttachmentPaths
    
    ' Now send the message
    On Error Resume Next
    oMessage.Send
    If Err.Number = 0 Then
        FnSafeSendEmail = True
    Else
        oMessage.Delete
    End If
    Err.Clear
    On Error GoTo 0

    Set oOutlook = Nothing ' This releases our reference to Outlook - if it was previously closed, it will be closed automatically once email sent
End Function

Private Sub AddRecipients(oMessage As Outlook.MailItem, sRecipientList As String, lRecipientType As Long)
    ' Add the recipients to the message
    
    Dim aRecpts() As String
    Dim sRecpt As Variant
    Dim oRecpt As Outlook.Recipient
    
    aRecpts = Split(sRecipientList, ";")
    For Each sRecpt In aRecpts
        Set oRecpt = oMessage.Recipients.Add(Trim(sRecpt))
        oRecpt.Type = lRecipientType
        oRecpt.Resolve
    Next
End Sub

Private Sub AddAttachments(oMessage As Outlook.MailItem, sAttachments As String)
    ' Add the attachment(s) to the message
    
    Dim aAttachments() As String
    Dim sAttachment As Variant
    Dim oFSO As New Scripting.FileSystemObject
    
    aAttachments = Split(sAttachments, ";")
    For Each sAttachment In aAttachments
        If oFSO.FileExists(sAttachment) Then
            oMessage.Attachments.Add sAttachment
        End If
    Next
End Sub

Discussione: [VBA] Passare variabili da Access a Outlook

Strumenti discussione

Ricerca discussione

Visualizza

[VBA office2010 64bit] Passare variabili da access a outlook

Permessi di invio