Newsgroup: it.comp.appl.access
Titolo: Inviare una Mail da access a Microsoft Outlook con allegati

Vorrei inviare una mail  da Access  a Microsoft Outlook
 
ho trovato in rete questa funzione 
' Procedure : SendEmail
' Author    : CARDA Consultants Inc.
' Website   : 
http://www.cardaconsultants.com
 
' Purpose   : Automate Outlook to send emails with or without attachments
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strTo         To Recipient email address string (semi-colon separated list)
' strSubject    Text string to be used as the email subject line
' strBody       Text string to be used as the email body (actual message)
' bEdit         True/False whether or not you wish to preview the email before sending
' strBCC        BCC Recipient email address string (semi-colon separated list)
' AttachmentPath    single value or array of attachment (complete file paths with
'                   filename and extensions)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2007-Nov-16             Initial Release
'---------------------------------------------------------------------------------------
Function SendEmail(strTo As String, strSubject As String, strBody As String, bEdit As Boolean, _
                   Optional strBCC As Variant, Optional AttachmentPath As Variant)
'Send Email using late binding to avoid reference issues
   Dim objOutlook As Object
   Dim objOutlookMsg As Object
   Dim objOutlookRecip As Object
   Dim objOutlookAttach As Object
   Dim i As Integer
   Const olMailItem = 0
 
   On Error GoTo ErrorMsgs
 
   Set objOutlook = CreateObject("Outlook.Application")
 
   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
   With objOutlookMsg
      Set objOutlookRecip = .Recipients.Add(strTo)
      objOutlookRecip.Type = 1
 
      If Not IsMissing(strBCC) Then
        Set objOutlookRecip = .Recipients.Add(strBCC)
        objOutlookRecip.Type = 3
      End If
 
      .Subject = strSubject
      .Body = strBody
      .Importance = 2  'Importance Level  0=Low,1=Normal,2=High
 
      ' Add attachments to the message.
      If Not IsMissing(AttachmentPath) Then
        If IsArray(AttachmentPath) Then
           For i = LBound(AttachmentPath) To UBound(AttachmentPath) - 1
              If AttachmentPath(i) <> "" And AttachmentPath(i) <> "False" Then
                Set objOutlookAttach = .Attachments.Add(AttachmentPath(i))
              End If
           Next i
        Else
            If AttachmentPath <> "" Then
                Set objOutlookAttach = .Attachments.Add(AttachmentPath)
            End If
        End If
      End If
 
      For Each objOutlookRecip In .Recipients
         If Not objOutlookRecip.Resolve Then
            objOutlookMsg.Display
         End If
      Next
 
      If bEdit Then 'Choose btw transparent/silent send and preview send
        .Display
      Else
        .Send
      End If
   End With
 
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
   Set objOutlookRecip = Nothing
   Set objOutlookAttach = Nothing
 
ErrorMsgs:
   If err.Number = "287" Then
      MsgBox "You clicked No to the Outlook security warning. " & _
      "Rerun the procedure and click Yes to access e-mail " & _
      "addresses to send your message. For more information, " & _
      "see the document at 
http://www.microsoft.com/office
" & _
      "/previous/outlook/downloads/security.asp."
      Exit Function
   ElseIf err.Number <> 0 Then
      MsgBox err.Number & " - " & err.Description
      Exit Function
   End If
End Function
 
 
Ho bisogno di allegare  una serie di file  quindi un Array
Da  una maschera  con il pulsante  
 
Private Sub cmdInviaAoutlook_Click()
    Dim db As DAO.Database
    Dim rst As Recordset
    Dim strSQL As String
    Dim strAllegati As String
 
10        strSQL = "SELECT tblDoc.*, * " & vbCrLf & _
             "FROM tblDoc " & vbCrLf & _
             "WHERE (((tblDoc.IdProblemi)= " & [Forms]![frmProblemi]![IdProblemi] & "));"
20    Set db = CurrentDb
30    Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
40    If rst.RecordCount > 0 Then
50      rst.MoveLast
60      Do Until rst.BOF
70          strAllegati = strAllegati & """" & rst![strPath] & """, "
80          rst.MovePrevious
90      Loop
100   End If
'110   strAllegati = strAllegati & " "" """
110   strAllegati = strAllegati & """"""
'120   Debug.Print strAllegati
 
Dim A As Variant
' se copio il contenuto di debug.print strAllegati
' come qui sotto
'A = Array("C:\Tabelle PSolving\Archivio\FOTO\Carlo2006.bmp", "C:\Tabelle PSolving\Archivio\FOTO\Cattura.PNG", "")
'e lancio SendMail
' SendEmail "
mia...@gmail.com
", "Prova", "In allegato", True, , A
' tutto funziona
 
' io vorrei passare l'array
120   A = Array(strAllegati)
130    SendEmail "
mia...@gmail.com
", "Prova", "In allegato", True, , A
 
' mi si apre correttamente la Mail  ma  senza allegati
 
140   rst.Close
 
End Sub
 
 
Dove sbaglio  penso che non sia corretta la sintassi  a riga 120 
 

Il 28/12/2015 20:26, scaronic ha scritto:
"a" e "da" in italiano non sono la stessa cosa.
Non si inviano mail a Outlook si inviano mail, punto.
 
cos'e' strallegati?
 
120 A = Array("C:\Tabelle PSolving\Archivio\FOTO\Carlo2006.bmp", 
"C:\Tabelle PSolving\Archivio\FOTO\Cattura.PNG", "")
130    SendEmail "
mia...@gmail.com
", "Prova", "In allegato", True, , A
 
cosi?
-- 
ac (x=y-1)
Aborro il Killfile
(La violenza e' l'ultimo rifugio degli incapaci -Salvor Hardin-)
 
---
Questa e-mail è stata controllata per individuare virus con Avast antivirus.
https://www.avast.com/antivirus
 
 


strAllegati è il risultato 
dei percorsi degli allegati che voglio allegare alla mail .
la riga 110  che nel mio test assume il valore : "C:\Tabelle PSolving\Archivio\FOTO\Carlo2006.bmp", "C:\Tabelle PSolving\Archivio\FOTO\Cattura.PNG", ""
 
se utilizzo 
A = Array(strAllegati)
SendEmail "
mia...@gmail.com
", "Prova", "In allegato", True, , A
viene creata la Mail  senza allegati
 
se utilizzo il valore 
A= Array ("C:\Tabelle PSolving\Archivio\FOTO\Carlo2006.bmp", "C:\Tabelle PSolving\Archivio\FOTO\Cattura.PNG", "")
SendEmail "
mia...@gmail.com
", "Prova", "In allegato", True, , A
la mail viene creata e vengono allegati i file 
 
Spero di essere sufficientemente chiaro.
 
 
 


sicuro che la variabile strAllegati contenga ancora i valori da te indicati?
 
prova a modificare il codice cosi e vedi cosa ti da msgbox
 
  A = Array(strAllegati)
msgbox strAllegati
SendEmail "
mia...@gmail.com
", "Prova", "In allegato", True, , A
 
 
ciao
BFS
 
 
 
 


A BFS
ho provato ad inserire  dopo 
A = Array(strAllegati) 
 
msgBox strAllegati
 
ma la msgbox mi conferma il contenuto 
"C:\Tabelle PSolving\Archivio\FOTO\Carlo2006.bmp", "C:\Tabelle PSolving\Archivio\FOTO\Cattura.PNG", ""
 
hai qualche altra idea ?

 Spero di essere sufficientemente chiaro.
 
Non molto o meglio mi sembra che hai non chiaro come si gestisca un array
se strallegati contiene "a,b,c,d,e"
a= array(strallegati)
in a(0) hai "a,b,c,d,e" e non il solo "a"
se a=split(strallegati,",") allora hai 5 elementi che contengono
rispettivamente "a", "b"....etc
 
P.S. Nelle risposte, per favore, taglia la roba che non serve (esempio 
la mia firma)



Penso sicuramente di non aver chiaro come si gestisce un Array è per questo che ho chiesto aiuto
Ripeto le mie prove dall'inizio 
 
Private Sub cmdInviaAoutlook_Click()
10    On Error GoTo ErrorHandler
    Dim db As DAO.Database
    Dim rst As Recordset
    Dim strSQL As String
    Dim strAllegati As String
 
20        strSQL = "SELECT tblDoc.*, * " & vbCrLf & _
             "FROM tblDoc " & vbCrLf & _
             "WHERE (((tblDoc.IdProblemi)= " & [Forms]![frmProblemi]![IdProblemi] & "));"
30    Set db = CurrentDb
40    Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
50    If rst.RecordCount > 0 Then
60      rst.MoveLast
70      Do Until rst.BOF
80          strAllegati = strAllegati & """" & rst![strPath] & """, "
90          rst.MovePrevious
100     Loop
110   End If
120   strAllegati = strAllegati & """"""
130   Debug.Print strAllegati
 
Dim A As Variant
 
140   A = Array(strAllegati)
 
150    SendEmail "
mia...@gmail.com
", "Prova", "In allegato", True, , A
 
160   rst.Close
 
 
ExitErrorHandler:
180   On Error Resume Next
190        Exit Sub
ErrorHandler:
200         MsgBox Erl & vbNewLine & err.Number & vbNewLine & err.Description, , "cmdInviaAoutlook_Click" & " - " & Me.Name
210   Resume ExitErrorHandler
 
End Sub
 
--------
Alla riga 130 
strAllegati ha valore "C:\Tabelle PSolving\Archivio\FOTO\Carlo2006.bmp", "C:\Tabelle PSolving\Archivio\FOTO\Cattura.PNG", ""
alla riga 140 definisco l'Array
 
alla riga 150 la funzione mi Apre una Mail in outlook , purtroppo senza allegati
 
 
se invece sostituisco la riga 140 con
140 A= Array("C:\Tabelle PSolving\Archivio\FOTO\Carlo2006.bmp", "C:\Tabelle PSolving\Archivio\FOTO\Cattura.PNG", "")
 
la funzione mi Apre una Mail in outlook , CON I DUE  allegati
 
non capisco dove dovrei usare 
A = split(strAllegati; ",")
 
Grazie per la pazienza
 
 
 


Ho provato  a sostituire  la riga  140 con
140 A = split (strallegati,",")
ma ottengo l'errore seguente
-
2147024773
 - Nome del File o della directory non valido

 hai qualche altra idea ?
 
'Siano gli allegati:
'D:\aa1.txt
'D:\aa2.bmp
'D:\aa3.jpg
Dim AttachmentArray(1 To 3) As String
Dim NewMail As MailItem
AttachmentArray(1) = "D:\aa1.txt"
AttachmentArray(2) = "D:\aa1.bmp"
AttachmentArray(3) = "D:\aa1.ipg"
...
With NewMail
    ...
    For i = 1 To 3
        .Attachments.Add AttachmentArray(i)
    Next
    ...
    .Send
End With
...
 
Se vuoi ti mando l'intera procedura (una mezza pagina A4).
 
Bruno


HO RISOLTO GRAZIE
 
posto la soluzione per eventuali altri utilizzatori
 
Private Sub cmdInviaAoutlook_Click()
10    On Error GoTo ErrorHandler
    Dim db As DAO.Database
    Dim rst As Recordset
    Dim strSQL As String
    Dim strAllegati As String
 
20        strSQL = "SELECT tblDoc.*, * " & vbCrLf & _
             "FROM tblDoc " & vbCrLf & _
             "WHERE (((tblDoc.IdProblemi)= " & [Forms]![frmProblemi]![IdProblemi] & "));"
30    Set db = CurrentDb
40    Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
50    If rst.RecordCount > 0 Then
60      rst.MoveLast
70      Do Until rst.BOF
80          strAllegati = strAllegati & rst![strPath] & ","
90          rst.MovePrevious
100     Loop
110   End If
'130   Debug.Print strAllegati
 
Dim A As Variant
120   A = Split(strAllegati, ",")
130    SendEmail "
mia...@gmail.com
", "Prova", "In allegato", True, , A
 
140   rst.Close
 
 
ExitErrorHandler:
150   On Error Resume Next
160        Exit Sub
ErrorHandler:
170         MsgBox Erl & vbNewLine & err.Number & vbNewLine & err.Description, , "cmdInviaAoutlook_Click" & " - " & Me.Name
180   Resume ExitErrorHandler
 
End Sub
 
 
Ho variato la riga 80
 
e la 120 come suggerito da A Cara