Newsgroup: it.comp.lang.visual-basic
Titolo: Send Mail in VB6

    mi necessita urgentemente inviare tramite codice VB6 delle email in
automatico dal mio server (niente paura, non per spamming, ma per rispondere
a dei clienti...).
Ho provato alcuni codici scaricati dalla rete (send-mail, Mime64184)
mandando delle mail ad una mia casella di posta, ma su questa non č arrivato
mai niente, sembra che non le spedisca (premetto che ho controllato tutti i
parametri di connessione), e non ritorna neanche nessun errore di sistema.
Perchč non riesco a spedire le email?
C'č qualcuno che mi possa suggerire come poter fare?

Caro Walter,
il problema è vecchio, basta dare un'occhiata a Google per rendersene
conto...
In pratica ci sono due sistemi, uno semplice che, però con consente di
inviare allegati ed uno più complesso che usa i controlli MAPI.
Per il primo, ti invio il codice.
In un modulo inserisci:
Declare Function ShellExecuteA Lib "SHELL32.DLL" (ByVal HWND&, ByVal OP$,
ByVal LP$, ByVal PARAM$, ByVal DIREC$, ByVal SHOWCMD&) As Long
In un Form inserisci due pulsanti Command1 e Command2, i controlli
MAPISESSION e MAPIMESSAGES con questo codice:
    Dim Dest$(1 To 10)
    Dim DestCC$(1 To 10)
    Dim DestCCN$(1 To 10)
    Dim Allegati$(1 To 10)
    Dim Messaggio$
    Dim Oggetto$
Public Sub InviaEmailMAPI(Dest$(), DestCC$(), DestCCN$(), Oggetto$,
Messaggio$, Allegati$())
    If Dest$(LBound(Dest$)) = "" Or Messaggio$ = "" Then Exit Sub
    On Error GoTo ErroreMAPI
'===========================================================================
    If MAPISES.SessionID = 0 Then                       'sessione non aperta
    MAPISES.SignOn                                      'nuova sessione
    End If
    MAPIMSG.SessionID = MAPISES.SessionID               'associa
    MAPIMSG.Compose                                     'reset buffer
'---------------------------------------------------------------------------
    For I% = LBound(Dest$) To UBound(Dest$)             'scan destinatari
    If Dest$(I%) = "" Then Exit For
    If MAPIMSG.RecipCount Then
    MAPIMSG.RecipIndex = MAPIMSG.RecipIndex + 1
    End If
    MAPIMSG.RecipType = mapToList                       '0=mitt, 1=dest,
2=destCC, 3=destCCN
    MAPIMSG.RecipAddress = Dest$(I%)
    Next I%
'---------------------------------------------------------------------------
    For I% = LBound(DestCC$) To UBound(DestCC$)         'scan destinatari CC
    If DestCC$(I%) = "" Then Exit For
    If MAPIMSG.RecipCount Then
    MAPIMSG.RecipIndex = MAPIMSG.RecipIndex + 1
    End If
    MAPIMSG.RecipType = mapCcList                       '0=mitt, 1=dest,
2=destCC, 3=destCCN
    MAPIMSG.RecipAddress = DestCC$(I%)
    Next I%
'---------------------------------------------------------------------------
    For I% = LBound(DestCCN$) To UBound(DestCCN$)       'scan destinatari
CCN
    If DestCCN$(I%) = "" Then Exit For
    If MAPIMSG.RecipCount Then
    MAPIMSG.RecipIndex = MAPIMSG.RecipIndex + 1
    End If
    MAPIMSG.RecipType = mapBccList                      '0=mitt, 1=dest,
2=destCC, 3=destCCN
    MAPIMSG.RecipAddress = DestCCN$(I%)
    Next I%
'---------------------------------------------------------------------------
    For I% = LBound(Allegati$) To UBound(Allegati$)     'scan allegati
    If Allegati$(I%) = "" Then Exit For
    If MAPIMSG.AttachmentCount Then
    MAPIMSG.AttachmentIndex = MAPIMSG.AttachmentIndex + 1
    End If
    MAPIMSG.AttachmentPathName = Allegati$(I%)
    Next I%
'---------------------------------------------------------------------------
    MAPIMSG.MsgSubject = Oggetto$
    MAPIMSG.MsgNoteText = Messaggio$
'---------------------------------------------------------------------------
    MAPIMSG.Send True                                   'True=anteprima
outlook
    MAPISES.SignOff                                     'chiude sessione
    Exit Sub
'===========================================================================
ErroreMAPI:
    Err.Raise Err.Number, "Send E.mail MAPI", Err.Description
End Sub
Public Sub InviaEmailVBScript(Dest$(), DestCC$(), DestCCN$(), Oggetto$,
Messaggio$, Allegati$())
    If Dest$(LBound(Dest$)) = "" Or Messaggio$ = "" Then Exit Sub
    On Error GoTo ErroreVBScript
'===========================================================================
    Z$ = "MailTo:"
    For I% = LBound(Dest$) To UBound(Dest$)             'scan destinatari
    If Dest$(I%) = "" Then Exit For
    Z$ = Z$ & Dest$(I%) & ";"
    Next I%
    Z$ = Left$(Z$, Len(Z$) - 1)
'---------------------------------------------------------------------------
    Z$ = Z$ & "?BODY=" & Messaggio$
    Z$ = Z$ & "&SUBJECT=" & Oggetto$
'---------------------------------------------------------------------------
    If DestCC$(LBound(DestCC$)) <> "" Then
    Z$ = Z$ & "&CC="
    For I% = LBound(DestCC$) To UBound(DestCC$)         'scan destinatari CC
    If DestCC$(I%) = "" Then Exit For
    Z$ = Z$ & DestCC$(I%) & ";"
    Next I%
    Z$ = Left$(Z$, Len(Z$) - 1)
    End If
'---------------------------------------------------------------------------
    If DestCCN$(LBound(DestCCN$)) <> "" Then
    Z$ = Z$ & "&bCC="
    For I% = LBound(DestCCN$) To UBound(DestCCN$)       'scan destinatari
CCN
    If DestCCN$(I%) = "" Then Exit For
    Z$ = Z$ & DestCCN$(I%) & ";"
    Next I%
    Z$ = Left$(Z$, Len(Z$) - 1)
    End If
'---------------------------------------------------------------------------
'    If Allegati$(LBound(Allegati$)) <> "" Then          'non funziona con
Outlook Express, ma forse con Outlook!
'
'    Z$ = Z$ & "&ATTACHMENT="
'
'    For I% = LBound(Allegati$) To UBound(Allegati$)     'scan allegati
'    If Allegati$(I%) = "" Then Exit For
'    Z$ = Z$ & Allegati$(I%) & ";"
'    Next I%
'
'    Z$ = Left$(Z$, Len(Z$) - 1)
'
'    End If
'---------------------------------------------------------------------------
    Ret& = ShellExecuteA(0, vbNullString, Z$, vbNullString, vbNullString, 1)
    Exit Sub
'===========================================================================
ErroreVBScript:
    Err.Raise Err.Number, "Send E.mail VBScript", Err.Description
End Sub
Private Sub Command1_Click()
    InviaEmailMAPI Dest$(), DestCC$(), DestCCN$(), Oggetto$, Messaggio$,
Allegati$()
End Sub
Private Sub Command2_Click()
    InviaEmailVBScript Dest$(), DestCC$(), DestCCN$(), Oggetto$, Messaggio$,
Allegati$()
End Sub
Private Sub Form_Load()
    Dest$(1) = "
de...@cyberhs.it
"
    Dest$(2) = "
de...@cyberhs.it
"
    DestCC$(1) = "
des...@cyberhs.it
"
    DestCC$(2) = "
des...@cyberhs.it
"
    DestCCN$(1) = "
dest...@cyberhs.it
"
    DestCCN$(2) = "
dest...@cyberhs.it
"
    Messaggio$ = "Messaggio di prova"
    Oggetto$ = "Prova"
    Allegati$(1) = "C:\Documenti\CYBER\LAVORI\ELEA\ENEL.MDB"
    Allegati$(2) = "C:\Documenti\CYBER\LAVORI\ELEA\ENEL.MDE"
End Sub
-- 
Ciao!
Ettore Massimo Albani
(leva ANTISPAMMER dall'indirizzo per inviare messaggi)