<%@LANGUAGE="VBSCRIPT"%> <% '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Spd E-Letter v4 ' © 2001, 2002 PensaWorks, inc. ' For help with this program, please visit http://www.pensaworks.com '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '================================= '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Subscriber DB Import Module v1 ' by Lane Williams '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Access = "User" : Nav3 = "1" %> <% thisPage = Mid(request.servervariables("SCRIPT_NAME"), InstrRev(request.servervariables("SCRIPT_NAME"), "/") + 1) response.buffer = true server.scripttimeout = 10000 Dim dbStr, sSQL, dbSQL, rsSQL Sub OpenDB Set dbSQL = Server.CreateObject("ADODB.Connection") dbSQL.Open dbStr End Sub Sub CloseDB dbSQL.Close Set dbSQL = Nothing End Sub Sub OpenRS Set rsSQL = Server.CreateObject("ADODB.Recordset") Set rsSQL.ActiveConnection = dbSQL rsSQL.CursorType = 3 rsSQL.Open sSQL,,,&H0002 End Sub Sub CloseRS rsSQL.Close Set rsSQL = Nothing End Sub '================================= %> <%=ListName%> - Spd E-Letter Administration

Subscriber DB Import

<% if request("step") = "" or request("step") = "0" then %>
Import Subscribers from another Database.

Open Saved Subscriber DB Connections
<% on error resume next err = 0 dbimpID = "" dbimpListID = "" dbimpFormat = "" dbimpDB = "dsn=DSNName;uid=;pwd=;" dbimpSQL = "SELECT FirstName, LastName, Email FROM Users" dbimpNamefield = "FirstName" dbimpName2field = "LastName" dbimpEmailfield = "Email" dbimpDescription = "" if request("step") = "0" then sSQL = "SELECT * FROM DB_Import WHERE (dbimpID = "&request("DBList")&")" set rsSQL = mlConn.Execute(sSQL) rsSQL.MoveFirst dbimpID = rsSQL("dbimpID") dbimpListID = rsSQL("dbimpListID") dbimpFormat = rsSQL("dbimpFormat") dbimpDB = rsSQL("dbimpdb") dbimpSQL = rsSQL("dbimpsql") dbimpNamefield = rsSQL("dbimpNamefield") dbimpName2field = rsSQL("dbimpName2field") dbimpEmailfield = rsSQL("dbimpEmailfield") dbimpDescription = rsSQL("dbimpDescription") rsSQL.Close() Set rsSQL = Nothing end if %>

<% if dbimpDescription = "" then %> New Subscriber DB Import <% else %> <%=dbimpDescription%> <% end if %>

List:
Format:
 >Text >HTML

DB Connection:

SQL String:

  
Name Field:
First or First/Last Last
Email Field:
Description: <% if dbimpDescription = "" then %> <% else %> <%=dbimpDescription%> <% end if %>


 

Open Saved Subscribers DB Connection: If you have saved any previous settings you can select one here and open it to either edit further or run.

List:  The Mailing List you want to send the Subscribers to.

Format:  The format you want the Subscribers to use.

DB Connection:  Any valid database connection string.
Examples:
-- DSNName
-- dsn=DSNName;uid=;pwd=;
-- dsn=DSNName;uid=USERNAME;pwd=PASSWORD;
-- DRIVER={Microsoft Access Driver(*.mdb)};DBQ=c:\db\db.mdb
-- Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\db\db.mdb

SQL String:  A "SELECT" SQL statement to retrieve the names and emails from the database connected to with the DB Connection.
 Examples:
-- SELECT Name, Email FROM Users
-- SELECT FirstName, LastName, Email FROM Users
-- SELECT Name, Email, Date FROM Users WHERE (Date >=1/1/2002)

Name Field:  This is the field or fields to read the Name from in the SQL String.  If the first and last name are in the same field in the SQL String then only put in the field name in the first text box and leave the second text box blank.  If there are 2 separate fields in the SQL String for the first and last name then put the field name in their respective text boxes.

Email Field:  This is the field to read the Email from in the SQL String.

Description:  If you want to save this particular setup then input a short description here.  If this is left blank it will not be saved.  If this was already saved then you will not be able to change this description.

Save and Test Connection:  Click here to save the current settings and test the database connection and SQL string.  This will not actually save any Subscribers to the mailing list.  If you leave the Description blank then the settings are not saved but the db connection  and SQL string are still tested.  If these setting are already saved and you have made changes to them, then the changes will be updated and the db connection and SQL string are tested.

Import Subscribers from DB Now:  Click here when you are ready to start the import of subscribers from your database to the mailing list.
 
<% end if if request("check") = "Save and Test Connection" then on error resume next err = 0 set dupCheck = mlConn.Execute("SELECT * FROM DB_Import WHERE dbimpDescription = '" & replace(request("description"), "'", "''") & "'") if dupCheck.EOF then sSQL = "INSERT INTO DB_Import (dbimpListID, dbimpFormat, dbimpDB, dbimpSQL, dbimpNamefield, dbimpName2field, dbimpEmailfield, dbimpDescription) VALUES (" & request("ListID") & ",'" & request("Format") & "','" & Replace(request("db"), "'", "''") & "','" & Replace(request("sql"), "'", "''") & "','" & Replace(request("Namefield"), "'", "''") & "','" & Replace(request("Name2field"), "'", "''") & "','" & Replace(request("Emailfield"), "'", "''") & "','" & Replace(request("description"), "'", "''") & "')" else sSQL = "UPDATE DB_Import SET " sSQL = sSQL & "dbimpListID = "&request("ListID")&", " sSQL = sSQL & "dbimpFormat = '"&request("Format")&"', " sSQL = sSQL & "dbimpDB = '"&Replace(request("db"), "'", "''") &"', " sSQL = sSQL & "dbimpSQL = '"&Replace(request("sql"), "'", "''") &"', " sSQL = sSQL & "dbimpNamefield = '"&Replace(request("Namefield"), "'", "''") &"', " sSQL = sSQL & "dbimpName2field = '"&Replace(request("Name2field"), "'", "''") &"', " sSQL = sSQL & "dbimpEmailfield = '"&Replace(request("Emailfield"), "'", "''") &"' " sSQL = sSQL & "WHERE dbimpDescription = '" & replace(request("description"), "'", "''") & "'" end if set dupCheck = nothing mlConn.Execute(sSQL) %>
Connection Test Mode
No Records are being Imported.
">Back to Subscriber DB Import
<% end if if request("step") = "1" then on error resume next err = 0 dbStr = request("db") OpenDB if err = 0 then sSQL = request("sql") if inStr(sSQL,vbCrLf) then sSQL = replace(sSQL,vbCrLf," ") if inStr(sSQL,chr(34)) then sSQL = replace(sSQL,chr(34),"'") OpenRS rcdCnt = rsSQL.RecordCount if rcdCnt > 0 then %>
Please wait while the DB import script processes the data, this could take several minutes. Once completed, a confirmation message will be displayed with the results of the import. Only Errors will appear on the page as they occur.

<%=request("description")%>
<%=rcdCnt%> Records Found
Bad DB Import Only


Import Record Error
<% rsSQL.MoveFirst nameFldStr = trim(request("Namefield")) name2FldStr = trim(request("Name2field")) emailFldStr = trim(request("Emailfield")) If (request("ListID") = "") then response.redirect "message.asp?msg=20" ListID = CInt(request("ListID")) if not allowedList(listID, allowedLists) then response.redirect "message.asp?msg=49" start = Now dim mlListName set mlListName = mlConn.Execute("SELECT ListName FROM ML_Lists WHERE ListID = " & ListID) if (mlListName.EOF) then response.redirect "message.asp?msg=25" mlListName = mlListName("ListName") dim count, mlRecError, currClr, idxCheck dim totCount, addCount, dupCount, errCount, emlCount, msgCount, delCount totCount = 0 addCount = 0 dupCount = 0 errCount = 0 emlCount = 0 msgCount = 0 delCount = 0 blkCount = 0 dateCount = 0 idxCheck = 0 currClr = true count = 0 do until rsSQL.EOF mlRecError = "" totCount = totCount + 1 subName = "" subName = trim(rsSQL(nameFldStr)) if name2FldStr <> "" then subName = subName & " " & trim(rsSQL(name2FldStr)) end if emailStr = trim(rsSQL(emailFldStr)) if inStr(emailStr," ") then emailStr = replace(emailStr," ","") if inStr(emailStr,">") then emailStr = replace(emailStr,">","") if inStr(emailStr,"<") then emailStr = replace(emailStr,"<","") if inStr(emailStr,"(") then emailStr = replace(emailStr,"(","") if inStr(emailStr,")") then emailStr = replace(emailStr,")","") if inStr(emailStr,":") then emailStr = replace(emailStr,":","") if inStr(emailStr,",") then emailStr = replace(emailStr,",","") if inStr(emailStr,"'") then emailStr = replace(emailStr,"'","") if verifyEmail(emailStr) then subEmail = emailStr subFormat = verifyFormat(request("Format")) subDate = Now set mlCheckDuplicates = mlConn.Execute("SELECT * FROM ML_Subscribers Where Email = '" & Replace(subEmail, "'", "''") & "' AND ListID = " & ListID) If NOT mlCheckDuplicates.EOF Then mlRecError = "Already Subscribed" : dupCount = dupCount + 1 else domain = split(subEmail, "@") : MLDomain = domain(UBound(domain)) set blockedDomain = mlConn.Execute("SELECT * FROM ML_Blocked WHERE blkType = 0 and blkText = '" & replace(MLDomain, "'", "''") & "'") if NOT blockedDomain.EOF then mlRecError = "Blocked Domain" : blkCount = blkCount + 1 else if NOT IsDate(subDate) then mlRecError = "Invalid Subscribe Date" : dateCount = dateCount + 1 else if request("check") = "Import Subscribers from DB Now" then mlConn.Execute("INSERT INTO ML_Subscribers (Name, Email, Format, ListID, SubscribedDate, numClicks, numReads, numBounces, numReplies, subRemoved, subRemovedDate, subMessageID) VALUES ('" & Replace(subName, "'", "''") & "','" & Replace(subEmail, "'", "''") & "','" & subFormat & "','" & ListID & "'," & getNumFromDate(subDate) & ",0,0,0,0,0,0,0)") end if addCount = addCount + 1 end if end if end if set mlCheckDuplicates = nothing else mlRecError = "Invalid E-Mail" emlCount = emlCount + 1 end if if mlRecError <> "" then currClr = not currClr errCount = errCount + 1 %> >
<%= subName & " " & rsSQL(emailFldStr)%> <%=mlRecError%>
<% end if response.flush() rsSQL.MoveNext if (addCount >= 10 or dupCount >= 10 or emlCount >= 10) and request("check") = "Save and Test Connection" then exit do loop end if CloseRS CloseDB if errCount = 0 then currClr = not currClr %>
There were no errors.
<% end if %>

<% if request("check") = "Save and Test Connection" then %>
Connection Test Mode
<%=addCount+dupCount+emlCount%> records tested
">Back to Subscriber DB Import
<% else %>
Subscriber DB Import Results
Subscriber import completed in <%=DateDiff("s", start, Now)%> seconds.
<%=addCount%> successful subscriptions to "<%=mlListName%>" out of <%=totCount%> total import Records.
<%=errCount%> errors (not subscribed, listed above).
<%=dupCount%> duplicate records.
<%=emlCount%> invalid e-mails.
<%=blkCount%> blocked domains.
<%=msgCount%> invalid Format types.
<%=dateCount%> invalid Subscribe dates.
<% end if set mlConn = nothing set mlListName = nothing set mlCheckDuplicates = nothing set blockedDomain = nothing else Response.write "There was a problem with your DB Connection" end if end if %>
Subscriber DB Import v1.0
 Lane Williams