Hej Dim objMail Tack för ditt svar, får felmeddelandet:Från SMTPsvg.Mailer till CDONTS.NewMail
Nu vet jag inte om jag är ute och cyklar totalt men skulle behöva ändra från SMTPsvg.Mailer till CDONTS.NewMail, jag ändrade till cdonts och scriptet kunde skriva till databasen men inte skicka iväg mailet till mottagaren, fick felmeddelandet: Microsoft VBScript runtime error '800a000d'.
Finns det någon som är insatt i hur man ändrar SMTPsvg.Mailer till CDONTS.NewMail?
SMTPsvg.Mailer delen:
<%
Function SendEmail( sEmailServer, sFromEmail, sToEmail, sSubject, sText )
Dim objMail
set objMail = server.createobject("SMTPsvg.Mailer")
objMail.FromName = sFromEmail
objMail.FromAddress = sFromEmail
objMail.RemoteHost = sEmailServer
objMail.AddRecipient sToEmail, sToEmail
objMail.Subject = sSubject
objMail.BodyText = sText
if objMail.SendMail then
SendEmail = ""
else
' Message send failure
SendEmail = objMail.Response
end if
Set objMail = nothing
End Function
%>
Delen som skickar iväg:
' First of all lets just get all variables
Dim nCardId, sNameTo, sNameFrom, sEmailFrom, sText, sBGColor, sTextColor, sEmailTo
Dim sOtherId
Function Password_GenPass( nNoChars, sValidChars )
' nNoChars = length of generated password
' sValidChars = valid characters. If zerolength-string
' default is used: A-Z AND a-z AND 0-9
Const szDefault = "abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789"
Dim nCount
Dim sRet
Dim nNumber
Dim nLength
Randomize 'init random
If sValidChars = "" Then
sValidChars = szDefault
End If
nLength = Len( sValidChars )
For nCount = 1 To nNoChars
nNumber = Int((nLength * Rnd) + 1)
sRet = sRet & Mid( sValidChars, nNumber, 1 )
Next
Password_GenPass = sRet
End Function
nCardId = Request.Form("fldAuto")
if nCardId = "" Then
Response.Redirect "."
End If
'Ok...
sNameTo = Request.Form("nameto")
sNameFrom = Request.Form("namefrom")
sEmailFrom = Request.Form("emailfrom")
sEmailTo = Request.Form("emailto")
sGreeting = Request.Form("greeting")
sText = Request.Form("S1")
sBGColor = Request.Form("BgColor")
sTextColor = Request.Form("TColor")
'Save it to database
Dim oRS
Set oConn = PostCard_GetDatabaseConn()
oConn.Execute "update " & Postcard_GetTablePrefix() & "card set sendcount=sendcount+1 where fldAuto=" & nCardId
Set oRS = Server.CreateObject("ADODB.Recordset")
If Postcard_GetDatabaseType() = "Access" Then
oRS.Open "select fldAuto, cardid, nameto, namefrom, emailto, emailfrom, greeting, otherid, bgcolor, textcolor, stext from " & Postcard_GetTablePrefix() & "createdpostcards where fldAuto=-1 " ,oConn ,adOpenKeyset,adLockOptimistic
Else
oRS.CursorLocation = adUseClient
oRS.Open "select fldAuto, cardid, nameto, namefrom, emailto, emailfrom, greeting, otherid, bgcolor, textcolor, stext from " & Postcard_GetTablePrefix() & "createdpostcards where fldAuto=-1 " ,oConn ,adOpenDynamic,adLockOptimistic
End If
oRS.AddNew
oRS("cardid") = nCardId
oRS("nameto") = sNameTo
oRS("namefrom") = sNameFrom
oRS("emailto") = sEmailTo
oRS("emailfrom") = sEmailFrom
oRS("greeting") = sGreeting
oRS("stext") = sText
oRS("bgcolor") = sBGColor
oRS("textcolor") = sTextcolor
sOtherId = Password_GenPass( 10, "" )
oRS("otherid")= sOtherId
oRS.Update
Dim IDToSend
IDToSend = sOtherId & oRS("fldAuto").Value
oRS.Close
Set oRS = Nothing
oConn.Close
Set oConn = Nothing
strMsgHeader = sNameFrom & "(" & sEmailFrom & ")" & " has sent you a postcard!" & vbCrLf
strMsgHeader = "The address to pick it up is : " & GetPathToPickupScript() & "?cardid=" & IDToSend
strMsgFooter = vbCrLf & vbCrLf & "This card was sent and created with the postcardservice at http://www.aspcode.net"
Dim sErr
sErr = SendEmail( Postcard_GetmailServer(), Postcard_GetmailFrom(), CStr(sEmailTo), sNameFrom & " has sent you a postcard", strMsgHeader & strMsgFooter )
If sErr = "" Then
Response.Redirect "vykortthanks.asp"
Response.Flush
Response.End
else
' Message send failure
Response.Write ("An error has occurred.<BR>")
' Send error message
Response.Write ("The error was " & sErr)
End If
%>
Oehört tacksam för hjälp!
/MickeSv: Från SMTPsvg.Mailer till CDONTS.NewMail
Set objMail = Server.CreateObject("CDONTS.NewMail")
objMail.From = Request.form("email")
objMail.Subject = "Re: Online Order"
objMail.To = Request.form("email")
objMail.bcc = "" & receipt & ""
objMail.Body = "Din text"
objMail.Send
set objMail = nothing
//Anna-KarinSv:Från SMTPsvg.Mailer till CDONTS.NewMail
Körningsfel i Microsoft VBScript error '800a000d'
Inkompatibla typer: 'SendEmail'
att göra själva cdonts filen är den lätta bitten, problemet är med koden:
<%
' First of all lets just get all variables
Dim nCardId, sNameTo, sNameFrom, sEmailFrom, sText, sBGColor, sTextColor, sEmailTo
Dim sOtherId
Function Password_GenPass( nNoChars, sValidChars )
' nNoChars = length of generated password
' sValidChars = valid characters. If zerolength-string
' default is used: A-Z AND a-z AND 0-9
Const szDefault = "abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789"
Dim nCount
Dim sRet
Dim nNumber
Dim nLength
Randomize 'init random
If sValidChars = "" Then
sValidChars = szDefault
End If
nLength = Len( sValidChars )
For nCount = 1 To nNoChars
nNumber = Int((nLength * Rnd) + 1)
sRet = sRet & Mid( sValidChars, nNumber, 1 )
Next
Password_GenPass = sRet
End Function
nCardId = Request.Form("fldAuto")
if nCardId = "" Then
Response.Redirect "."
End If
'Ok...
sNameTo = Request.Form("nameto")
sNameFrom = Request.Form("namefrom")
sEmailFrom = Request.Form("emailfrom")
sEmailTo = Request.Form("emailto")
sGreeting = Request.Form("greeting")
sText = Request.Form("S1")
sBGColor = Request.Form("BgColor")
sTextColor = Request.Form("TColor")
'Save it to database
Dim oRS
Set oConn = PostCard_GetDatabaseConn()
oConn.Execute "update " & Postcard_GetTablePrefix() & "card set sendcount=sendcount+1 where fldAuto=" & nCardId
Set oRS = Server.CreateObject("ADODB.Recordset")
If Postcard_GetDatabaseType() = "Access" Then
oRS.Open "select fldAuto, cardid, nameto, namefrom, emailto, emailfrom, greeting, otherid, bgcolor, textcolor, stext from " & Postcard_GetTablePrefix() & "createdpostcards where fldAuto=-1 " ,oConn ,adOpenKeyset,adLockOptimistic
Else
oRS.CursorLocation = adUseClient
oRS.Open "select fldAuto, cardid, nameto, namefrom, emailto, emailfrom, greeting, otherid, bgcolor, textcolor, stext from " & Postcard_GetTablePrefix() & "createdpostcards where fldAuto=-1 " ,oConn ,adOpenDynamic,adLockOptimistic
End If
oRS.AddNew
oRS("cardid") = nCardId
oRS("nameto") = sNameTo
oRS("namefrom") = sNameFrom
oRS("emailto") = sEmailTo
oRS("emailfrom") = sEmailFrom
oRS("greeting") = sGreeting
oRS("stext") = sText
oRS("bgcolor") = sBGColor
oRS("textcolor") = sTextcolor
sOtherId = Password_GenPass( 10, "" )
oRS("otherid")= sOtherId
oRS.Update
Dim IDToSend
IDToSend = sOtherId & oRS("fldAuto").Value
oRS.Close
Set oRS = Nothing
oConn.Close
Set oConn = Nothing
strMsgHeader = sNameFrom & "(" & sEmailFrom & ")" & " has sent you a postcard!" & vbCrLf
strMsgHeader = "The address to pick it up is : " & GetPathToPickupScript() & "?cardid=" & IDToSend
strMsgFooter = vbCrLf & vbCrLf & "This card was sent and created with the postcardservice at http://www.aspcode.net"
Dim Mail
Set Mail = SendEmail( Postcard_GetmailServer(), Postcard_GetmailFrom(), CStr(sEmailTo), sNameFrom & " has sent you a postcard", strMsgHeader & strMsgFooter )
If sErr = "" Then
Response.Redirect "vykortthanks.asp"
Response.Flush
Response.End
else
' Message send failure
Response.Write ("An error has occurred.<BR>")
' Send error message
Response.Write ("The error was " & sErr)
End If
%>
felet leder till denna kod:
Dim Mail
Set Mail = SendEmail( Postcard_GetmailServer(), Postcard_GetmailFrom(), CStr(sEmailTo), sNameFrom & " has sent you a postcard", strMsgHeader & strMsgFooter )
Cdonts och koderna här ovan går inte ihop, någon som kan hjälpa mig med det?
/Micke