enviar un archivo adjunto en un formulario que envia un mail desde asp

[jUaN_]

Muy buenos dias a todos


Necesito saber si en un formulario que luego envia un mail via asp, es posible que me pueda adjuntar un archivo que elija la persona que esta enviando, alguien sabe si se puede hacer esto?


muchas gracias por todo

Saludos!!

[Saruman]

Hola.... este ejemplo funciona super bien.... tiene demasiado de cosas porque me dio "pereza" quitarle lo que no interesa... pero si conoces sabes que utilizar... cualquier cosa me avisas que yo voy a estar OnLine



default.asp

<!--#include file="uploadtomessage.asp"-->

<title>Enviar E-Mails a los Miembros del Sitio</title>

<script language="javascript">
function enviaremails() {
var f = document.form1

if (f.txtnombre.value == "") {
alert("Debe colocar su Nombre al Mensaje.")
f.txtnombre.focus()
return false
}

if (f.txtasunto.value == "") {
alert("Debe colocar un Asunto al Mensaje.")
f.txtasunto.focus()
return false
}

if (f.txtcontenido.value == "") {
alert("Debe colocar el Contenido del Mensaje.")
f.txtcontenido.focus()
return false
}

return true
}
</script>

<%
server.ScriptTimeout = 100000000

strDBPath = "/db/datos.mdb"
Set Master = Server.CreateObject("ADODB.Connection")
Master.Open("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath(strDBPath))

Dim Uploader, File
Set Uploader = New FileUploader

Uploader.Upload()

nombre = Uploader.form("txtnombre")
asunto = Uploader.form("txtasunto")
contenido = Uploader.form("txtcontenido")

Ruta = strMainDir & "scripts/newsletter/"

if nombre <> "" then
If Uploader.Files.Count <> 0 Then
For Each File In Uploader.Files.Items
File.SaveToDisk Server.MapPath(Ruta)
Next
end if

sSQL = "select * from clientes"
set RSUsuarios = Master.Execute(sSQL)

sSQL = "select * from parametros"
set RSParametros = Master.Execute(sSQL)

if RSUsuarios.bof=false and RSUsuarios.eof=false then
while not RSUsuarios.eof
mensaje = ""
mensaje = "Hola " & RSUsuarios("nombreclien") & "." & VbCrLf
mensaje = mensaje & nombre & " le ha enviado la siguiente información:" & VbCrLf & VbCrLf
mensaje = mensaje & contenido & "." & VbCrLf & VbCrLf
mensaje = mensaje & "Sus amigos de " & strCompanyName & VbCrLf
mensaje = mensaje & "---------------------------------------" & VbCrLf
mensaje = mensaje & "Enviado desde " & strCompanyName

Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
Mailer.FromName = FromName
Mailer.FromAddress= RSParametros("emailsend")
Mailer.RemoteHost = RemoteHost
Mailer.AddRecipient RSUsuarios("nombreclien"), RSUsuarios("emailclien")
Mailer.Subject = asunto
Mailer.ContentType = "text/html"
Mailer.BodyText = mensaje
If Uploader.Files.Count <> 0 Then
For Each File In Uploader.Files.Items
Mailer.AddAttachment Server.MapPath(Ruta & File.FileName)
archivo = File.FileName
Next
end if
Mailer.SendMail

RSUsuarios.movenext
wend
end if


end if

if nombre = "" then
%>
<form action="newsletter.asp" method="post" enctype="multipart/form-data" name="form1" onSubmit="return enviaremails()">
<table width="95%" border="0" align="center" cellpadding="0" cellspacing="0" class="TablasTitulo">
<tr>
<td width="84%" height="20">&nbsp;Enviar E-Mails a los Miembros del Sitio</td>
<td width="16%"><div align="right"><a href="<%=(strMainDir)%>scripts/admin.asp"><img src="<%=(strMainDir)%>_gui/icon_salir.gif" border="0"></a></div></td>
</tr>
</table>
<table width="95%" border="0" cellspacing="0" cellpadding="0" class="Tablas">
<tr>
<td width="18%" height="22">&nbsp;Su Nombre: </td>
<td width="82%" height="22"><input name="txtnombre" type="text" size="60" maxlength="50"></td>
</tr>
<tr>
<td height="22">&nbsp;Asunto: </td>
<td height="22"><input name="txtasunto" type="text" size="60" maxlength="50"></td>
</tr>
<tr>
<td height="22">&nbsp;Datos Adjuntos : </td>
<td height="22"><input name="file1" type="file" size="60"></td>
</tr>
<tr>
<td>&nbsp;Mensaje: </td>
<td><textarea name="txtcontenido" cols="60" rows="6"></textarea>
<br>
<br></td>
</tr>
</table>
<br>
<br>
<input type="submit" name="Submit" value="Enviar" class="Botones">
</form>
<%
else
%>
<table width="95%" border="0" cellspacing="0" cellpadding="0" class="TablasTitulo">
<tr>
<td height="20">&nbsp;Enviar E-Mails a los Miembros del Sitio</td>
</tr>
</table>
<table width="95%" border="0" cellspacing="0" cellpadding="0" class="Tablas">
<tr>
<td height="46"><div align="center">El Mensaje se ha enviado correctamente a todos los miembros del Sitio</div></td>
</tr>
</table>
<br>
<input type="button" name="Submit2" value="Regresar" onClick="document.location.href='newsletter.asp'" class="Botones">
<%
end if
%>






uploadtomessage.asp


<%
Class FileUploader
Public Files
Private mcolFormElem

Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary")
Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
End Sub

Private Sub Class_Terminate()
If IsObject(Files) Then
Files.RemoveAll()
Set Files = Nothing
End If
If IsObject(mcolFormElem) Then
mcolFormElem.RemoveAll()
Set mcolFormElem = Nothing
End If
End Sub

Public Property Get Form(sIndex)
Form = ""
If mcolFormElem.Exists(LCase(sIndex)) Then Form = mcolFormElem.Item(LCase(sIndex))
End Property

Public Default Sub Upload()
Dim biData, sInputName
Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
Dim nPosFile, nPosBound

biData = Request.BinaryRead(Request.TotalBytes)
nPosBegin = 1
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))

If (nPosEnd-nPosBegin) <= 0 Then Exit Sub

vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
nDataBoundPos = InstrB(1, biData, vDataBounds)

Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))

nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
nPos = InstrB(nPos, biData, CByteString("name="))
nPosBegin = nPos + 6
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
nPosBound = InstrB(nPosEnd, biData, vDataBounds)

If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile, sFileName
Set oUploadFile = New UploadedFile

nPosBegin = nPosFile + 10
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))

nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
nPosBegin = nPos + 14
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))

oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))

nPosBegin = nPosEnd+4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)

If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
Else
nPos = InstrB(nPos, biData, CByteString(Chr(13)))
nPosBegin = nPos + 4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
If Not mcolFormElem.Exists(LCase(sInputName)) Then mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
End If

nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
Loop
End Sub

'String to byte string conversion
Private Function CByteString(sString)
Dim nIndex
For nIndex = 1 to Len(sString)
CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
Next
End Function

'Byte string to string conversion
Private Function CWideString(bsString)
Dim nIndex
CWideString =""
For nIndex = 1 to LenB(bsString)
CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1)))
Next
End Function
End Class

Class UploadedFile
Public ContentType
Public FileName
Public FileData

Public Property Get FileSize()
FileSize = LenB(FileData)
End Property

Public Sub SaveToDisk(sPath)
Dim oFS, oFile
Dim nIndex

If sPath = "" Or FileName = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"

Set oFS = Server.CreateObject("Scripting.FileSystemObject")
If Not oFS.FolderExists(sPath) Then Exit Sub

Set oFile = oFS.CreateTextFile(sPath & FileName, True)

For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next

oFile.Close
End Sub

Public Sub SaveToDatabase(ByRef oField)
If LenB(FileData) = 0 Then Exit Sub

If IsObject(oField) Then
oField.AppendChunk FileData
End If
End Sub

End Class
%>