SendMailAttach

'Utilizzanto Exchange o OutLook:

Public Sub Invio_Posta(Optional strIndirizzo As String, _
Optional strTipo As String, _
Optional strSubject As String, _
Optional strText As String, _
Optional strNome As String, _
Optional strProfilo As String, _
Optional strPassword As String, _
Optional strAttachment As String, _
Optional strIndirizzoCC As String, _
Optional strTipoCC As String)

On Error GoTo GestErrPosta

Dim objMessage As Object
Dim objRecip As Object
Dim objAttach As Object

Set objSession = CreateObject("MAPI.session")
objSession.logon profilename:=strProfilo, profilepassword:=strPassword 'Apertura sessione

If objSession Is Nothing Then
Err.Raise vbObjectError + 70000, , "Errore di inizializzazione del client di posta"
GoTo Fine
End If
'Creazione Messaggio

Set objMessage = objSession.outbox.messages.Add
If objMessage Is Nothing Then
Err.Raise vbObjectError + 70001, , "Errore creazione del messaggio"
GoTo Fine
End If
With objMessage
.subject = strSubject
.Text = strText
End With
'Creazione Recipiente

Set objRecip = objMessage.recipients.Add
If objRecip Is Nothing Then
Err.Raise vbObjectError + 70002, , "Errore creazione del
contenitore"
GoTo Fine
End If
With objRecip
.address = strTipo & ":" & strIndirizzo
.Name = strNome
.Type = MAPI_TO
'.address = strTipoPostaCC & ":" & strIndirizzoCC

'.Name = strNome

'.Type = MAPI_CC

End With
objRecip.resolve showdialog:=bshowdialog
'Attachment file

If strAttachment <> "" Then
Set objAttach = objMessage.attachments.Add
If objAttach Is Nothing Then
Err.Raise vbObjectError + 70003, , "Errore creazione del'Attachment"
GoTo Fine
End If
With objAttach
.Position = 0
.Name = strAttachment
'.Type = MAPI_FILEDATA

.ReadFromFile (strAttachment)
End With
objMessage.Update
End If
'Invio

sID = objMessage.id
If intVisPosta = 1 Then
objMessage.send showdialog:=True, savecopy:=True
Else
objMessage.send showdialog:=False, savecopy:=True
End If
'fine

Fine:
objSession.Logoff
Set objSession = Nothing
Exit Sub
GestErrPosta:
If Err <> -2147221229 Then
ERRORI "Invio_Posta"
End If
Resume Next
End Sub