Conversione CDONTS > CDOSYS

**simonemusiu** · 29-11-2005, 14:21

Ciao a tutti una domandina :

mi servirebbe un aiutino per convertire questo codice di invio email da CDONST A CDOSYS , vi posto il codice grazie ..

----------------------------------------------------------------------
Sub SendEmail(strEmail, strEmailType)

strMsg = ""
If strEmailType = "html" Then
CdoBodyFormat = 0
CdoMailFormat = 0
strMessaggio = strMessaggio & "
"
strMsg = "<HTML>"
strMsg = strMsg & "<HEAD><TITLE>Messaggio Urgente</TITLE></HEAD>"
strMsg = strMsg & "<BODY BGCOLOR=""#FFFFCC"">"
strMsg = strMsg & "

" & strOthApertura & "

"
strMsg = strMsg & strMessaggio
strMsg = strMsg & "

" & strOthChiusura & "
"
strMsg = strMsg & "</BODY>"
strMsg = strMsg & "</HTML>"
Else
CdoBodyFormat = 1
CdoMailFormat = 1
strMessaggio = strMessaggio & vbCrLf
strMsg = strMsg & strOthApertura & vbCrLf & vbCrLf
strMsg = strMsg & strMessaggio & vbCrLf & vbCrLf
strMsg = strMsg & strOthChiusura & vbCrLf
Call ConvertToPlainText(strMsg)
End If

Set objNewMail = CreateObject("CDONTS.NewMail")

objNewMail.From = strFromAddress
objNewMail.To = strEmail
objNewMail.Bcc = strBccAddress
objNewMail.Importance = 2
objNewMail.Subject = strObjectOthEmail
objNewMail.BodyFormat = CdoBodyFormat
objNewMail.MailFormat = CdoMailFormat
objNewMail.Body = strMsg

objNewMail.Send
set objNewMail = Nothing

Response.Write "Un messaggio di posta elettronica è stato spedito all'indirizzo " & strEmail & ".
"

End Sub

---------------------------------------------------------------------

**Roby_72** · 29-11-2005, 14:35

Tanti esempi: http://www.weppos.com/asp/script/categoria_email.asp

Roby

**simonemusiu** · 29-11-2005, 15:15

mi da errori strani
non riesco ad adattare i nuovi script
Praticamente e un invio automatico che avviene da un'altra pagina.

boo
vedi te
grazie

**simonemusiu** · 29-11-2005, 20:39

Mi da sempre errore

boo
che cavolo puo essere
ti posto tutto il codice :

<% Option Explicit %>
<%
If Not Session("admin") Then
Response.Redirect("/pages/userError.htm")
Else
Dim intNrOfUsers, strVisualizza, strOrdina, strRecords
intNrOfUsers = Request.QueryString("ut")
strVisualizza = Request("vis")
strOrdina = Request("ord")
strRecords = Request("pas")
%>

<%
' ************************************************** ******************
' INSERIMENTO NELLE VARIABILI DEI PARAMETRI DELLA TABELLA IMPOSTAZIONI
' ************************************************** ******************

Dim objRso, strSql, strObjectOthEmail, strOthApertura, strOthCancellazione, strOthAttivazioneStd
Dim strOthAttivazioneAdm, strOthAttivazioneAdmOnly, strOthDisattivazioneStd, strOthDisattivazioneAdm, strOthChiusura
Dim strFromAddress, strBccAddress, intCnt
Set objRso = Server.CreateObject("ADODB.Recordset")
strSql = "SELECT strObjectOthEmail, strOthApertura, strOthCancellazione, strOthAttivazioneStd, " & _
"strOthAttivazioneAdm, strOthAttivazioneAdmOnly, strOthDisattivazioneStd, strOthDisattivazioneAdm, strOthChiusura, " & _
"strFromAddress, strBccAddress FROM tblImpostazioni"
objRso.Open strSql, objCon, adOpenkeyset, adLockReadOnly, adCmdText
strObjectOthEmail = objRso("strObjectOthEmail")
strOthApertura = objRso("strOthApertura")
strOthCancellazione = objRso("strOthCancellazione")
strOthAttivazioneStd = objRso("strOthAttivazioneStd")
strOthAttivazioneAdm = objRso("strOthAttivazioneAdm")
strOthAttivazioneAdmOnly = objRso("strOthAttivazioneAdmOnly")
strOthDisattivazioneStd = objRso("strOthDisattivazioneStd")
strOthDisattivazioneAdm = objRso("strOthDisattivazioneAdm")
strOthChiusura = objRso("strOthChiusura")
strFromAddress = objRso("strFromAddress")
strBccAddress = objRso("strBccAddress")
objRso.Close

' ************************************************** ***********
' DIMENSIONAMENTO VARIABILI E APERTURA DEL RECORDSET PRINCIPALE
' ************************************************** ***********

Dim intCount, strStato, intId, bolError, bolAdmin, bolConferma, bolAttivato
Dim bolFrmAdmin, bolFrmConferma, bolFrmAttivato, strEmail, strMessaggio, objNewMail, strMsg
Dim CdoBodyFormat, CdoMailFormat, strEmailType, bolMessaggio
strSql = "SELECT * FROM tblUtenti"
objRso.Open strSql, objCon, adOpenKeyset, adLockOptimistic, adCmdText

' ************************************************** ******************************
' CONTROLLO DELLA RICHIESTA DA PARTE DELL'AMMINSTRATORE - CANCELLAZIONE O MODIFICA
' ************************************************** ******************************

For intCount = 1 To intNrOfUsers
strStato = Request.Form("frmScelta_" & intCount)
If strStato = "CANCELLA" Then
intId = Request.Form("frmId_" & intCount)
objRso.Filter = "id = " & intId
If objRso.Recordcount = 1 Then
strEmail = objRso("strEmail")
strEmailType = objRso("strEmailType")
strMessaggio = strOthCancellazione
objRso.Delete
objRso.Filter = "id = " & intId
If objRso.Recordcount > 0 Then
Response.Write "Problemi nella cancellazione dell'account specificato.
"
Response.Write "Si prega di riprovare.
"
Else
Call SendEmail(strEmail, strEmailType)
End If
End If
ElseIf strStato = "MODIFICA" Then
intId = Request.Form("frmId_" & intCount)
objRso.Filter = "id = " & intId
If objRso.Recordcount = 1 Then
strEmail = objRso("strEmail")
strEmailType = objRso("strEmailType")
bolAdmin = objRso("bolAdmin")
bolConferma = objRso("bolConferma")
bolAttivato = objRso("bolAttivato")
bolFrmAdmin = Request.Form("frmAdmin_" & intCount)
bolFrmAttivato = Request.Form("frmAttivato_" & intCount)
If Not bolConferma And (bolFrmAttivato = "ON" Or bolFrmAdmin="ON") Then
Response.Write "Operazione non effettuata. La registrazione deve essere prima confermata.
"
Elseif bolFrmAdmin = "ON" And bolFrmAttivato <> "ON" Then
Response.Write "Operazione non effettuata. Permessi di amministrazione e attivazione devono coincidere.
"
ElseIf ((bolFrmAttivato = "ON" And bolAttivato = True) And ((bolFrmAdmin = "ON" And bolAdmin = True) Or (bolFrmAdmin <> "ON" And bolAdmin = False))) Then
Response.Write "Nessuna modifica da effettuare.
"
ElseIf ((bolFrmAttivato <> "ON" And bolAttivato = False) And ((bolFrmAdmin = "ON" And bolAdmin = True) Or (bolFrmAdmin <> "ON" And bolAdmin = False))) Then
Response.Write "Nessuna modifica da effettuare.
"
Else
If (bolFrmAttivato = "ON" And bolAttivato = False) And (bolFrmAdmin <> "ON" And bolAdmin = False) Then
strMessaggio = strOthAttivazioneStd
objRso("bolAttivato") = True
ElseIf (bolFrmAttivato = "ON" And bolAttivato = False) And (bolFrmAdmin = "ON" And bolAdmin = False) Then
strMessaggio = strOthAttivazioneAdm
objRso("bolAttivato") = True
objRso("bolAdmin") = True
ElseIf (bolFrmAttivato = "ON" And bolAttivato = True) And (bolFrmAdmin = "ON" And bolAdmin = False) Then
strMessaggio = strOthAttivazioneAdmOnly
objRso("bolAdmin") = True
ElseIf (bolFrmAttivato = "ON" And bolAttivato = True) And (bolFrmAdmin <> "ON" And bolAdmin = True) Then
strMessaggio = strOthDisattivazioneAdm
objRso("bolAdmin") = False
ElseIf (bolFrmAttivato <> "ON" And bolAttivato = True) Then
strMessaggio = strOthDisattivazioneStd
objRso("bolAttivato") = False
objRso("bolAdmin") = False
End If
objRso.Update
Call SendEmail(strEmail, strEmailType)
End If
End If
End If
Next

objRso.Close
Set objRso = Nothing

' ************************************************** *
' SUBROUTINE SPEDIZIONE E-MAIL ALL'UTENTE INTERESSATO
' ************************************************** *

Sub SendEmail(strEmail, strEmailType)

strMsg = ""
If strEmailType = "html" Then
CdoBodyFormat = 0
CdoMailFormat = 0
strMessaggio = strMessaggio & "
"
strMsg = "<HTML>"
strMsg = strMsg & "<HEAD><TITLE>Messaggio Urgente</TITLE></HEAD>"
strMsg = strMsg & "<BODY BGCOLOR=""#FFFFCC"">"
strMsg = strMsg & "

" & strOthApertura & "

"
strMsg = strMsg & strMessaggio
strMsg = strMsg & "

" & strOthChiusura & "
"
strMsg = strMsg & "</BODY>"
strMsg = strMsg & "</HTML>"
Else
CdoBodyFormat = 1
CdoMailFormat = 1
strMessaggio = strMessaggio & vbCrLf
strMsg = strMsg & strOthApertura & vbCrLf & vbCrLf
strMsg = strMsg & strMessaggio & vbCrLf & vbCrLf
strMsg = strMsg & strOthChiusura & vbCrLf
Call ConvertToPlainText(strMsg)
End If

Set objNewMail = CreateObject("CDO.Message")

objNewMail.From = strFromAddress
objNewMail.To = strEmail
objNewMail.Bcc = strBccAddress
objNewMail.Importance = 2
objNewMail.Subject = strObjectOthEmail
objNewMail.HTMLBody = strMsg
'objNewMail.MailFormat = CdoMailFormat
'objNewMail.Body = strMsg

objNewMail.Send
set objNewMail = Nothing

Response.Write "Un messaggio di posta elettronica è stato spedito all'indirizzo " & strEmail & ".
"

End Sub

' ***************************************
' SUB ROUTINE CONVERSIONE DA HTML A TESTO
' ***************************************

Sub ConvertToPlainText(frase)
frase = Replace(frase, "<", "<")
frase = Replace(frase, ">", ">")
frase = Replace(frase, "&", "&")
frase = Replace(frase, """, chr(34))
frase = Replace(frase, "€", chr(128))
frase = Replace(frase, "‚", chr(130))
frase = Replace(frase, "ƒ", chr(131))
frase = Replace(frase, "„", chr(132))
frase = Replace(frase, "…", chr(133))
frase = Replace(frase, "†", chr(134))
frase = Replace(frase, "‡", chr(135))
frase = Replace(frase, "ˆ", chr(136))
frase = Replace(frase, "‰", chr(137))
frase = Replace(frase, "Š", chr(138))
frase = Replace(frase, "‹", chr(139))
frase = Replace(frase, "Œ", chr(140))
frase = Replace(frase, "Ž", chr(142))
frase = Replace(frase, "‘", chr(145))
frase = Replace(frase, "’", chr(146))
frase = Replace(frase, "“", chr(147))
frase = Replace(frase, "”", chr(148))
frase = Replace(frase, "•", chr(149))
frase = Replace(frase, "–", chr(150))
frase = Replace(frase, "—", chr(151))
frase = Replace(frase, "˜", chr(152))
frase = Replace(frase, "™", chr(153))
frase = Replace(frase, "š", chr(154))
frase = Replace(frase, "›", chr(155))
frase = Replace(frase, "œ", chr(156))
frase = Replace(frase, "ž", chr(158))
frase = Replace(frase, "Ÿ", chr(159))

For intCnt = 160 to 255
frase = Replace(frase, "&#" & intCnt & ";", chr(intCnt))
Next
End Sub
%>

<html>

**Roby_72** · 29-11-2005, 21:52

E soprattutto quale errore....??!!!

Roby

**simonemusiu** · 30-11-2005, 10:31

ciao

no praticamente mi appare la classica pagina di windows errore 500 impossibile visualizzare la pagina .

Premetto che la visualizzazione dei messaggi di errore li ho attivati tramite windows , nonostante cio non mi appare l'errore esatto.

boo

**Roby_72** · 30-11-2005, 10:47

Cambia browser.

Roby

**simonemusiu** · 30-11-2005, 13:45

l'errore era in questa riga :

objNewMail.Importance = 2

lo cancellata e ora non mi da piu errore

Grazie mille
Simone
Ciao
alla prossima

Discussione: Conversione CDONTS > CDOSYS

Strumenti discussione

Ricerca discussione

Visualizza

Conversione CDONTS > CDOSYS

Permessi di invio