Inviare una Mail da access a Microsoft Outlook con allegati

[scaronic]

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

[Alessandro Cara]

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

[scaronic]

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.

[BFS]

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

[scaronic]

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 ?

[Alessandro Cara]

Il 28/12/2015 23:53, scaronic ha scritto:

> Il giorno lunedì 28 dicembre 2015 21:27:11 UTC+1, Alessandro Cara ha scritto:
>> 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
>>
>

> strAllegati è il risultato
> dei percorsi degli allegati che voglio allegare alla mail .

Che vuol dire e' il risultato dei percorsi degli allegati?
Hai concatenato delle stringhe?
Come?
Immagino le hai separate con la virgola allora
A = split(strallegati,",")

> 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)

ottieni un array di 1 elemento e in quell'elemento c'e' l'intera stringa
risultato

> SendEmail "mia...@gmail.com", "Prova", "In allegato", True, , A
> viene creata la Mail senza allegati

e mi pare anche logico visto che A contiene un solo elemento con dentro
la concatenazione dei paths

>
> 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

E quindi dove e' il problema?

>
> 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)

[scaronic]

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

[scaronic]

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

[Bruno Campanini]

scaronic explained on 29-Dec-15 :

[...]

> 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 ?

'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

[scaronic]

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