Back-End

27 jul, 2009

Paginação de emails

Publicidade

Imagine que você tem uma base de dados com um número muito grande de emails e precisa enviar um email para todos, seja para promoção, noticias etc, chamamos isso de newsletter,porém se nossa listagem contém muitos email, oalguns servidores pode sobrecarregar e as mensagens poderão não serem enviadas corretamente, ou até mesmo, nem serem enviadas.

Para isso usanod a paginação, para exibir os dados e enviarmos um numero “x” de email por vez, dando assim tempo para que o servidor possa enviar todos os emails corretamente.

Primeiro, precisaremos fazer a conexão com nosso banco para enviar nossos emails

Para fazer a conexão iremos usar o código abaixo:

<% '----------------------
' este arq. serve para estabelecer a conexao com o BD em Access

sub abreconexao
constring="provider=microsoft.JET.OLEDB.4.0;Data Source=" & Server.MapPath("db/teste.mdb")
Set conexao=Server.CreateObject("ADODB.Connection")
conexao.open constring
end sub

sub fechaconexao
set conexao=nothing
end sub
%>

Onde no código de envio utilizamos ele através de um include file,

que com ele podemos inserir o conteúdo de um arquivo ASP em outro servidor antes de o arquivo ASP executa-lo, com a directiva # include.A directiva # include é usado para criar funções, cabeçalhos, rodapés, ou elementos que serão reutilizados em várias páginas.Ou seja, dessa forma não precisamos sempre ficar repetindo o código de conexão.

Abaixo o código, todo comentado, lembramos que, podemos utilizar qualquer outro coponente para envio de email, você pode verificar isso direto em seu host, para saber qual esta disponível. Você pode antes ter uma validação de usuário, para ver quem poderá enviar os emails, esta parte você pode também ver em nossos artigos um sistema de login, pois neste artigo não abordamos o login, mas é só implementá-lo junto com este código.

<!--#include file="conexao.asp"--> 
<%
varNome = Session("Login")
' aqui verificamos se o user esta logado, você pode , fazer essa
' implementação apartir de seu sistema de login
if varNome = "" then
response.redirect("checerro.asp")
' checerro é um arquivo para fazer a verifição se o nome estiver vazio
' dai redireciona, para a página e será exibido uma mensagem de erro adquada.
end if

dim conexao
Call abre_conexao

' recupera as variáveis para enviar os e-mails
'Lembrando que antes de fazer o envio, eu fiz um formulário para a
'pessoa poder escolher por qual filtro ele quer filtrar os e-mails
'E também fiz com que ele pudesse escolher o arquivo a ser enviado
'Isso utilizando o Componente de Upload ASpUpload.

assunto = request.form("assunto")
validade = request.form("validade")
empresa = request.form("empresa")
arquivo = request.form("arquivo")
str = request.form("str")
sql = request.form("sql")
' Como a pausa é feita por paginação, pag é a variavel que vai dizer em qual loop está agora

pag = request.form("pag")
if pag = "" then
pag = 1
end if
per = request.form("per")
CodigoCampanha = request.form("CodigoCampanha")
' reg é o nuemro de e-mails que ele irá enviar por bloco.
reg = 400

'Isto le o arquivo no qual foi feito o Upload
' strpatha é um path fixo que eu tenho na pagina de include.(para facilitar o código)
Set Objeto = CreateObject ("Scripting.FileSystemObject")
set GV = Objeto.OpenTextFile(strpath &arquivo,1,true,false)
HTML = GV.ReadAll
GV.close
Set Objeto = nothing
lista = Replace(lista," ","")

HTML = HTML
HTML2 = HTML

' A var sql, contem a SQL para de acordo com o filtro que a pessoa escolheu
if sql <> "" then

' Aqui eu pego quantos e-mails seram enviados

sqlCont = "Select Count(Email) as Cont From Emails where ("&str&") and (Ativo = true)"
Set rsCont = conexao.execute(sqlCont)
NumReg = rsCont("Cont")
' Aqui iremos determinas qual é o numero maximo de blocos
Maxpag = int(Cint(NumReg)/ Cint(reg))+1
Set rsCont = nothing

' Testamos se irá ter somente um bloco, se sim iremos enviar todos os e-mails de uma vez

if Cint(NumReg) <= Cint(reg) then
Set rs = conexao.execute(sql)

Set rsMax = Server.CreateObject("ADODB.Recordset")
rsMax.Open "Select Max(CodigoCampanha) As max_cod From Campanhas", conexao
If IsNull(rsMax("max_cod")) Then
CodigoCampanha = 100
Else
CodigoCampanha = rsMax("max_cod") + 1
End If
rsMax.Close
Set rsMax = Nothing

validade = date + CInt(validade)
sqlCampanha = "Insert Into Campanhas(CodigoCampanha,CodigoEmpresa,Assunto,Arquivo,Data,Validade) Values ("&CodigoCampanha&", "&empresa&", '"&assunto&"', '"&arquivo&"', '"&Now()&"','"&validade&"')"
Set rsCampanha = conexao.execute(sqlCampanha)
contador = 0
contador2 = 1
per = 1
per2 = 1
%>
<script language="JavaScript">
window.open('enviando.asp','enviando','width=350 height=200 status=yes');
</script>
<%
while not rs.eof
per = (100 * Cint(contador2))/Cint(NumReg) + 1

if Int(per) > Int(per2) then
per2 = per
%>
<script>
window.open('javascript:conta(<%=Int(per)%>,<%=Int(contador2)%>);','enviando','width=350 height=200 status=yes');
</script>
<%
end if
%>
<%

HTML = HTML2
sqlTestEnv = "Select Email From Enviados where CodigoCampanha = "&CodigoCampanha&" and Email = '"&rs("Email")&"'"
Set rsTestEnv = conexao.execute(sqlTestEnv)
if rsTestEnv.EOF then
aux = rs("Fantasia")
If InStr(aux, " ") > 0 Then
aux = Left(aux, InStr(aux, " ")-1 )
End If
Empresa = UCase(aux)

HTML = replace(HTML,"#Nome#",rs("Nome"))
HTML = replace(HTML,"#CodigoCampanha#",CodigoCampanha)
HTML = replace(HTML,"#Email#",rs("Email"))
HTML = replace(HTML,"#Empresa#",Empresa)

response.write HTML
assunto2 = replace(assunto,"#Nome#",rs("Nome"))

Dim myMail
Set myMail = CreateObject("CDONTS.NewMail")
myMail.From = "teste@teste.com"
myMail.To = rs("Email")
myMail.Subject = assunto2
myMail.BodyFormat = 0
myMail.MailFormat = 0
myMail.Body = HTML
myMail.Send
contador = contador +1
contador2 = Cint(contador2) +1
Set myMail = Nothing

sqlEnviados = "Insert Into Enviados(CodigoCampanha,Email,Nome,Cargo,Fantasia,Telefone,Data) Values ("&CodigoCampanha&",'"&rs("Email")&"','"&rs("Nome")&"','"&rs("Cargo")&"','"&rs("Fantasia")&"','"&rs("Telefone")&"','"&Now()&"')"
Set rsEnviados = conexao.execute(sqlEnviados)
end if
rs.MoveNext
wend
fim = true
else

' se tivermos mais de um bloco iremos ter que fazer a paginação

Set rs = conexao.execute(sql)
' Aqui inserimos na tabela Campanha os dados da mesma, só inserimos uma vez.
'É por isso que tomos este if, pois a 1ª vez o Codigo será branco.
if CodigoCampanha = "" then
Set rsMax = Server.CreateObject("ADODB.Recordset")
rsMax.Open "Select Max(CodigoCampanha) As max_cod From Campanhas", conexao
If IsNull(rsMax("max_cod")) Then
CodigoCampanha = 100
Else
CodigoCampanha = rsMax("max_cod") + 1
End If
rsMax.Close
Set rsMax = Nothing

validade = date + CInt(validade)
sqlCampanha = "Insert Into Campanhas(CodigoCampanha,CodigoEmpresa,Assunto,Arquivo,Data,Validade) Values ("&CodigoCampanha&", "&empresa&", '"&assunto&"', '"&arquivo&"', '"&Now()&"','"&validade&"')"
Set rsCampanha = conexao.execute(sqlCampanha)
end if
' aqui contador é o que vale a quantidade de e-mails que esta sendo enviado e-mails
' contador 2 é um contador auxiliar para abrirmos uma pag de porcetagem do envio
contador = ((Cint(pag) -1) * Cint(reg)) + 0
contador2 = ((Cint(pag) -1) * Cint(reg)) + 1
//per = 1
//per2 = 1
%>
' aqui testamos se é primeira vez que executamos a página, se sim iremos abrir a pag de porcentagem
<%
if Cint(pag) = 1 then
%>
<script language="JavaScript">
window.open('enviando.asp','enviando','width=350 height=200 status=yes');
</script>
<%
end if
%>
' Aqui testamos se é a primeira vez que executamos a página, se não for nos iremos ter que passar para os próximos 400 registros da tabela
<%
NumReg2 = Cint(reg) * (Cint(pag)-1)
If NumReg2 > 0 then
For LinkTemp = 1 to NumReg2
if rs.Eof = False then
rs.MoveNext
end if
Next
end if

regatual = 1
' aqui fazemos o loop da tabela de e-mails
while not rs.eof and regatual <= Cint(reg)
' per é uma variavel que ´rá ser envia para a página de porcentagem para mmostrar o andamento do envio

per = (100 * Cint(contador2))/Cint(NumReg) + 1

if Int(per) > Int(per2) then
per2 = per
%>

' este script atualiza a pagina de porcentagem sempre que novos e-mails são enviados
<script>
window.open('javascript:conta(<%=Int(per)%>,<%=Int(contador2)%>);','enviando','width=350 height=200 status=yes');
</script>
<%
end if
%>
<%
' Aqui fazemos uns replaces no arquivo (HTML) que foi feito o Upload.
'Isto é para podermos personalizar os e-mails
HTML = HTML2
sqlTestEnv = "Select Email From Enviados where CodigoCampanha = "&CodigoCampanha&" and Email = '"&rs("Email")&"'"
Set rsTestEnv = conexao.execute(sqlTestEnv)
if rsTestEnv.EOF then
aux = rs("Fantasia")
If InStr(aux, " ") > 0 Then
aux = Left(aux, InStr(aux, " ")-1 )
End If
Empresa = UCase(aux)

HTML = replace(HTML,"#Nome#",rs("Nome"))
HTML = replace(HTML,"#CodigoCampanha#",CodigoCampanha)
HTML = replace(HTML,"#Email#",rs("Email"))
HTML = replace(HTML,"#Empresa#",Empresa)

response.write HTML
assunto2 = replace(assunto,"#Nome#",rs("Nome"))
' Aqui estamos enviando os e-mails em formato HTML

Dim myMail2
Set myMail2 = CreateObject("CDONTS.NewMail")
myMail2.From = "teste@teste.com.br"
myMail2.To = rs("Email")
myMail2.Subject = assunto2
myMail2.BodyFormat = 0
myMail2.MailFormat = 0
myMail2.Body = HTML
myMail2.Send
regatual = regatual + 1
contador = Cint(contador) +1
contador2 = Cint(contador2) +1
Set myMail2 = Nothing
' Aqui gravamos em outra tablela todos os e-mails que para onde foram enviados. Para relatórios


sqlEnviados = "Insert Into Enviados(CodigoCampanha,Email,Nome,Cargo,Fantasia,Telefone,Data) Values ("&CodigoCampanha&",'"&rs("Email")&"','"&rs("Nome")&"','"&rs("Cargo")&"','"&rs("Fantasia")&"','"&rs("Telefone")&"','"&Now()&"')"
Set rsEnviados = conexao.execute(sqlEnviados)
end if
rs.MoveNext
wend
end if
'Testamos se é o ultimo loop, se sim iremos mostrar direto quantos e-mails foi enviado
if (Cint(pag) >= Cint(Maxpag)) then
fim = true
else

' Se naõ iremos fazer fim = falso para passarmos para o próximo bloco de e-mails após um tempo
fim = false
pag = Cint(pag) + 1
end if
end if
%>
<%
' Aqui testamos se chegou ao fim ou n~~ao, se não chegou ainda
'iremos fazer um formulário com todos os dados que teremos que ter
' iremos fazer um script para enviar este formulário novamente após um tempo
if fim = false then
%>
<HTML>
<HEAD>
<Title></Title>
<script>
function Envia()
{
document.form.submit();
}

setTimeout("Envia();",120000);

</script>
</HEAD>
<BODY>
<form name="form" method="post" action="camp3.asp">
<input type="hidden" name="sql" value="<%=sql%>">
<input type="hidden" name="assunto" value="<%=assunto%>">
<input type="hidden" name="arquivo" value="<%=arquivo%>">
<input type="hidden" name="empresa" value="<%=empresa%>">
<input type="hidden" name="str" value="<%=str%>">
<input type="hidden" name="pag" value="<%=pag%>">
<input type="hidden" name="codigocampanha" value="<%=CodigoCampanha%>">
<input type="hidden" name="per" value="<%=per%>">
</form>
</BODY>
</HTML>
<%
else
' Se chegou ao fim iremos mostrar a quantidade de e-mails que foi gerada
%>
<html>
<head>
<title>Email´s</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
</head>

<body bgcolor="#FFFFFF" text="#000000">
<table width="100%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td>
<div align="center"><font face="Verdana, Arial, Helvetica, sans-serif" size="2"><b>CONFIRMAÇÃO
DO CADASTRO DE CAMPANHA</b></font></div>
</td>
</tr>
<tr>
<td> </td>
</tr>
<tr>
<td> </td>
</tr>
<tr>
<td>
<table width="70%" border="0" cellspacing="0" cellpadding="0" align="center">
<%
if Cint(contador) > 0 then

sqlEmp = "Select * From Empresas where CodigoEmpresa = "&empresa&""
Set rsEmp = conexao.execute(sqlEmp)

msgBody = "<HTML>" & vbcrlf
msgBody = msgBody & "<body>" & vbcrlf
msgBody = msgBody & "Olá " & rsEmp("Nome") &",<br><br>" & vbcrlf
msgBody = msgBody & "A campanha com assunto : " & assunto &"<br>" & vbcrlf
msgBody = msgBody & "Foi disparada para "&contador&" email(s) de sua lista de e-mails.<br><br>" & vbcrlf
msgBody = msgBody & "Verifique logo abaixo o corpo do e-mail que foi disparado: <br><br> " & vbcrlf
msgBody = msgBody & HTML2 & vbcrlf
msgBody = msgBody & "</body>" & vbcrlf
msgBody = msgBody & "</HTML>" & vbcrlf

'response.write msgBody

Dim myMail3
Set myMail3 = CreateObject("CDONTS.NewMail")
myMail3.From = "teste@teste.co
myMail3.To = "xan@xan.com.br"'rsEmp("Email")
myMail3.Subject = "Comprovande do envio da campanha de Web Marketing: """ & assunto &""""
myMail3.BodyFormat = 0
myMail3.MailFormat = 0
myMail3.Body = HTML2
myMail3.Send
Set myMail3 = Nothing

%>
<tr>
<td>
<table width="100%" border="0" cellspacing="1" cellpadding="0" bgcolor="#333333">
<tr>
<td bgcolor="#DDFFEE">

<div align="center"><font size="3" face="Verdana, Arial, Helvetica, sans-serif"><br>
<br>
Campanha enviada com sucesso para<br>
<%=Contador & " "%> emil(s).<br>
<br>
</font></div>
</td>
</tr>
</table>
</td>
</tr>
<%
else
%>
<tr>
<td>

<table width="100%" border="0" cellspacing="1" cellpadding="0" bgcolor="#333333">
<tr>
<td bgcolor="#DDFFEE">
<div align="center"><font size="3" face="Verdana, Arial, Helvetica, sans-serif"><br>
</font><font size="4"><font face="Verdana, Arial, Helvetica, sans-serif"><br>
<font size="3">HÁ ALGUM CAMPO OBRIGATÓRI EM
BRANCO<br>
POR FAVOR REALIZE A OPERAÇÃO<br>
NOVAMENTE!! </font></font></font><font size="3" face="Verdana, Arial, Helvetica, sans-serif"><br>
<br>
</font></div>
</td>
</tr>
</table>
</td>
</tr>
<%
end if
%>
</table>
</td>
</tr>
</table>
<br>
<br>
<table width="94%" border="0" cellspacing="0" cellpadding="0" align="center">
<tr>
<td width="50%" height="13">
<div align="center"><a href="camp.asp"><font color="#003300" size="2" face="Verdana, Arial, Helvetica, sans-serif"><b><font color="#000000"><<
Voltar </font></b></font></a> </div>
</td>
<td width="50%" height="13">
<div align="center"><a href="checlogin2.asp"><font face="Verdana, Arial, Helvetica, sans-serif" size="1" color="#000000"><b><font size="2"><<
Voltar ao Menu Inicial</font></b></font></a></div>
</td>
</tr>
</table>
</body>
</html>
<%
end if
%>
<%
Call fecha_conexao
Set rs = Nothing
%>