<% Sub WriteColumnSelect(arrSubscriber) If IsArray(arrSubscriber) Then Response.Write "" Dim intX, intY, intYUB, strBG Dim intEnd : intEnd = 4 If intEnd > UBound(arrSubscriber, 2) Then intEnd = UBound(arrSubscriber, 2) End If intYUB = UBound(arrSubscriber) Response.Write "" strBG = "#818181" For intY = 0 To intYUB If strBG = "#999999" Then strBG = "#818181" Else strBG = "#999999" End If Response.Write "" Next Response.Write "" ' Response.Write "" For intX = 0 To intEnd strBG = "#818181" Response.Write "" For intY = 0 To intYUB If strBG = "#999999" Then strBG = "#818181" Else strBG = "#999999" End If Response.Write "" Next Response.Write "" Next Response.Write "

" Call WriteSelectBox(intY) Response.Write "

" & arrSubscriber(intY, intX) & "

" End If End Sub Sub WriteSelectBox(intY) Response.Write "" Response.Write "First Name" Response.Write "Last Name" Response.Write "Email" Response.Write " 3 Then Response.Write " selected=""selected""" End If Response.Write ">* Ignore" Response.Write "" End Sub Function GetSubscriberArray(strFileName, intDelType, strOther) Dim strList : strList = ReadPage("/admin/temp" & "/" & strFileName) Dim strDel : strDel = GetDelimiterValue(intDelType, strOther) Dim arrRows : arrRows = Split(strList, vbCrLf) Dim arrColumns Dim arrFull If IsArray(arrRows) Then'if there is more than one row Dim intUBR : intUBR = UBound(arrRows) Dim intUBC : intUBC = 0 Dim intX, intY 'loop once to get the max amount of columns For intX = 0 To intUBR arrColumns = Split(arrRows(intX), strDel) If IsArray(arrColumns) Then If UBound(arrColumns) > intUBC Then intUBC = UBound(arrColumns) End If End If Next Redim arrFull(intUBC, intUBR) For intX = 0 To intUBR arrColumns = Split(arrRows(intX), strDel) If IsArray(arrColumns) Then intUBC = UBound(arrColumns) If intUBC >= 0 Then For intY = 0 To intUBC arrFull(intY, intX) = arrColumns(intY) Next End If End If Next End If GetSubscriberArray = arrFull End Function Function GetDelimiterValue(intDelType, strOther) Dim strReturn Select Case intDelType Case 1 strReturn = "," Case 2 strReturn = chr(9) Case 3 strReturn = ";" Case 4 strReturn = strOther End Select GetDelimiterValue = strReturn End Function 'The GetPostingTypeOptions function takes the posting type id and returns an options list of posting types. Function GetPostingTypeOptions_i(intPostingTypeId) On Error Resume Next dim strPostingTypeOptionsList dim rsPostingTypes dim intTempPostingTypeId dim strPostingTypeName 'initialize the strPostingTypeOptionsList variable value to an empty string strPostingTypeOptionsList = "" 'get the Display Types into the rsDisplayTypes recordset Set rsPostingTypes = GetPostingTypes() 'loop through all of the posting types in the recordset Do While Not rsPostingTypes.Eof If rsPostingTypes("POSTING_TYPE_USER_CAN_SUBSCRIBE") = True Then 'set the posting type values into the relevant variables intTempPostingTypeId = rsPostingTypes("POSTING_TYPE_ID") strPostingTypeName = rsPostingTypes("POSTING_TYPE_NAME_ENG") 'concatenate the options list of posting types strPostingTypeOptionsList = strPostingTypeOptionsList & "" & strPostingTypeName & "" & vbCRLF End If 'go to the next record in the recordset rsPostingTypes.MoveNext Loop 'release the recordset from memory rsPostingTypes.Close Set rsPostingTypes = Nothing 'return the string of posting type options GetPostingTypeOptions_i = strPostingTypeOptionsList 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetPostingTypeOptions_i", err.number, err.description) End If On Error Goto 0 End Function Function GetGroupNames(strGroupList) Dim objRs Set objRs = Server.CreateObject("ADODB.recordset") Dim strSQL strSQL = "SELECT GROUP_NAME FROM GROUPS " & _ " WHERE GROUP_ID IN (" & Replace(strGroupList, "|", ",") & ") " 'TEST ' RESPONSE.WRITE STRsql objRs.Open strSQL, conn Set GetGroupNames = objRs Set objRs = Nothing End Function Function GetGroupNamesHTML(strGroupList) Dim rsGroupNames : Set rsGroupNames = GetGroupNames(strGroupList) If rsGroupNames.EOF = False Then Do Until rsGroupNames.EOF Response.Write rsGroupNames("GROUP_NAME") & "
" rsGroupNames.MoveNext Loop End If End Function Sub WritePreview(arrSubscriber, arrIndex) If IsArray(arrSubscriber) Then Response.Write "" Dim intX, intY, intYUB, strBG Dim intEnd : intEnd = UBound(arrSubscriber, 2) intYUB = UBound(arrSubscriber) Response.Write "" strBG = "#818181" For intY = 0 To intYUB If arrIndex(intY) <> 3 Then If strBG = "#999999" Then strBG = "#818181" Else strBG = "#999999" End If Response.Write "" End If Next Response.Write "" ' Response.Write "" For intX = 0 To intEnd strBG = "#818181" Response.Write "" For intY = 0 To intYUB If arrIndex(intY) <> 3 Then If strBG = "#999999" Then strBG = "#818181" Else strBG = "#999999" End If Response.Write "" End If Next Response.Write "" Next Response.Write "

" Call WriteSelectedColum(intY, arrIndex) Response.Write "

" & arrSubscriber(intY, intX) & "

" End If End Sub Sub WriteSelectedColum(intY, arrIndex) Select Case arrIndex(intY) Case 0 Response.Write "First Name" Case 1 Response.Write "Last Name" Case 2 Response.Write "Email" End Select End Sub Sub WriteInvalidRecordsHTML(strIndex, arrSubscribers, strErrorIndex, strErrorNumber) Dim intI, intFirstNameIndex, intLastNameIndex, intEmailIndex Dim arrIndex : arrIndex = Split(strIndex, "|") For intI = 0 To UBound(arrIndex) Select Case arrIndex(intI) Case 0 intFirstNameIndex = intI Case 1 intLastNameIndex = intI Case 2 intEmailIndex = intI End Select Next Dim intE, intS, intErrorCount, intPreviousIndex Dim bolHeaderWritten : bolHeaderWritten = False Dim arrEIndex : arrEIndex = Split(strErrorIndex, "|") Dim arrENumber : arrENumber = Split(strErrorNumber, "|") Response.Write "" If IsArray(arrEIndex) And IsArray(arrENumber) Then For intE = 0 To UBound(arrEIndex) If arrENumber(intE) <> "" Then If arrEIndex(intE) <> intPreviousIndex Then intErrorCount = intErrorCount + 1 End If If Not bolHeaderWritten Then bolHeaderWritten = True Response.Write "" End If Select Case arrENumber(intE) Case 1 Response.Write "" Case 2 Response.Write "" Case 3 Response.Write "" Case 4 Response.Write "" Case 5 Response.Write "" End Select intPreviousIndex = arrEIndex(intE) End If Next End If Response.Write "" Response.Write "

The following records were not added:
Line " & arrEIndex(intE) + 1 & ":	No first name provided
Line " & arrEIndex(intE) + 1 & ":	No last name provided
Line " & arrEIndex(intE) + 1 & ":	No email provided
Line " & arrEIndex(intE) + 1 & ":	Invalid Email (" & arrSubscribers(intEmailIndex, arrEIndex(intE)) & ")
Line " & arrEIndex(intE) + 1 & ":	Email already exists (" & arrSubscribers(intEmailIndex, arrEIndex(intE)) & ")
" & UBound(arrSubscribers, 2) + 1 - intErrorCount & " out of " & UBound(arrSubscribers, 2) + 1 & " records were successfully added to the database.

" End Sub Function GetSubscriberIdFromEmail(strEmail) ' On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_CONFIRM_SUBSCRIBER_EXISTS" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("SUBSCRIBER_EMAIL", adVarChar, adParamInput, 150, strEmail) cmd.Parameters.Append cmd.CreateParameter("SUBSCRIBER_ID", adInteger, adParamOutput) cmd.execute 'if an error has occured report it If err.number <> 0 Then Call ReportError("GetSubscriberIdFromEmail", err.number, err.description) End If 'return the language abbreviation GetSubscriberIdFromEmail = cmd.Parameters("SUBSCRIBER_ID") 'release cmd object from memory set cmd = nothing On Error Goto 0 End Function %>