Formulário retorna error '8004020f'

Olá,

Este formulário envia e-mail com anexo para os contatos de um banco de dados. Para poucos contatos está enviando, porém quando coloquei 8 mil contatos no banco ele esta reportando <b>error '8004020f' </b>

(linha do objCDOSYSMail.Send) do condigo abaixo.

Alguem pode me ajudar a solucionar isso? Segue codigo na íntegra!

<%
response.buffer = true
Server.ScriptTimeout = 1000000

v_situacao = " disabled" 'variavel que habilita os campos do e-mail
useraction=Request.QueryString("acao")
Select Case useraction 'Verifica parametro acao para executar determinado script
Case "upload" 'caso a acao seja upload, executa script do SaFileUp
Set obj_Upload = Server.CreateObject("SoftArtisans.FileUp")
obj_Upload.Path = Server.MapPath("./") 'local onde será gravado o arquivo
obj_Upload.Form("File").Save
Session("arquivo") = obj_Upload.Form("File").ServerName ''recupera o nome do arquivo no servidor
Response.Write "<script>alert('Total de Bytes Enviados: " & obj_Upload.TotalBytes & "')</script>"
Set obj_Upload = Nothing
v_situacao = "" ''habilita os campos pra enviar o e-mail
v_foco = " onLoad=" & chr(34) & "document.frm_email.txt_nome_rem.focus();" & chr(34)
Case "email" 'caso a acao seja email, executa script do CDOSYS
lista = emails()
if len(lista) > 0 then
Set objCDOSYSMail = Server.CreateObject("CDO.Message")
Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration") 'objeto de configuração do CDO
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "localhost"
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
objCDOSYSCon.Fields.update
Set objCDOSYSMail.Configuration = objCDOSYSCon
objCDOSYSMail.From = Trim(Request.Form("txt_nome_rem")) & "<" & Trim(Request.Form("txt_email_rem")) & ">"
objCDOSYSMail.To = Trim(Request.Form("txt_nome_rem")) & "<" & Trim(Request.Form("txt_email_rem")) & ">"
objCDOSYSMail.Bcc = lista ''Trim(Request.Form("txt_nome_para")) & "<" & Trim(Request.Form("txt_email_para")) & ">"
objCDOSYSMail.AddAttachment(Session("Arquivo")) ''anexa o arquivo
objCDOSYSMail.Subject = Request.Form("txt_assunto")
objCDOSYSMail.textBody = Request.Form("txt_corpo")
objCDOSYSMail.Send ''envia o e-mail com o anexo
Set objCDOSYSMail = Nothing
Set objCDOSYSCon = Nothing
Session("Arquivo") = ""
Response.Write "<script>alert('E-mail enviado com Sucesso!')</script>"
%>
<br>Redirecionando...</i><br><meta http-equiv="refresh" content="1;URL=index.asp" />
<%
else
response.write "<script>alert('A lista de emails no banco de dados está vazia, favor verificar');</script>"
%>
<br>Redirecionando...</i><br><meta http-equiv="refresh" content="1;URL=index.asp" />
<%
Session("Arquivo") = ""
end if

End Select

function emails() 'Retorna os emails cadastrados como uma string

dsn="DBQ=" & Server.Mappath("subs.mdb") & ";Driver={Microsoft Access Driver (*.mdb)};"

Set Conn = Server.CreateObject("ADODB.Connection")
Set Rs = Server.CreateObject("ADODB.Recordset")
Conn.Open dsn
SQL = "SELECT emails from emails order by id"
rs.Open SQL, Conn, 1, 3
do while not rs.eof
str = str & rs("emails") &","
rs.movenext
Loop
emails = str
end function

%>

Espero que alguem possa me ajudar, já tentei de tudo que estava dentro da minha capacidade.

MSN

marcos.plus@msn.com