Snitz Forums 2000
Snitz Forums 2000
Home | Profile | Register | Active Topics | Members | Search | FAQ
Username:
 Password:
Save Password
Forgot your Password?

 All Forums
 Snitz Forums 2000 MOD-Group
 MOD Add-On Forum (W/O Code)
 PM or Email specific Usergroups ?		  New Topic  Reply to Topic
 Printer Friendly
Author Previous Topic Topic Next Topic  

Webbo
Average Member

United Kingdom
982 Posts
Posted - 08 November 2011 :  15:43:18  Show Profile  Visit Webbo's Homepage  Reply with Quote
Has anyone written a Mod that enables the administrator to Private Message or Email specific Usergroups?

I have the Usergroups Mod installed, Private Messaging, and Email all Users and it would be a good feature to be able to send PMs or emails to each specific usergroup rather than doing it individually

Carefree
Advanced Member

Philippines
4207 Posts
Posted - 09 November 2011 :  00:35:58  Show Profile  Reply with Quote
If nobody has done it, I'll write it for you today.
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts
Posted - 09 November 2011 :  02:04:24  Show Profile  Visit Webbo's Homepage  Reply with Quote
I've searched and all I can find is a similar request in 2005 (http://forum.snitz.com/Forum/topic.asp?ARCHIVE=true&TOPIC_ID=58850)+

I'll leave it in your capable hands
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts
Posted - 10 November 2011 :  15:43:51  Show Profile  Reply with Quote
Here you go. Either copy the following and replace your "admin_pop_mail.asp" or get it from SnitzBitz.



<%
'###############################################################################
'##
'##      Snitz Forums 2000 v3.4.07
'##
'###############################################################################
'##
'## Copyright © 2000-09 Michael Anderson, Pierre Gorissen,
'##      Huw Reddick and Richard Kinser
'##
'## This program is free. You can redistribute and/or modIfy it under the
'## terms of the GNU General Public License as published by the Free Software
'## Foundation; either version 2 or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000 must remain intact in
'## the scripts and in the HTML output. The "powered by" text/logo with a
'## link back to http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful but
'## WITHOUT ANY WARRANTY; without even an implied warranty of MERCHANTABILITY
'## or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
'## for more details.
'##
'## You should have received a copy of the GNU General Public License along
'## with this program; If not, write to:
'##
'##      Free Software Foundation, Inc.
'##      59 Temple Place, Suite 330
'##      Boston, MA 02111-1307
'##
'## Support can be obtained from our support forums at:
'##
'##      http://forum.snitz.com
'##
'## Correspondence and marketing questions can be sent to:
'##
'##      manderson@snitz.com
'##
'###############################################################################
'##
'## Email All Users 3.4b by Kevin Whipp (http://the-nut.com)
'##
'###############################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_func_member.asp"-->
<!--#INCLUDE FILE="inc_sha256.asp"-->
<!--#INCLUDE FILE="inc_header.asp"-->
<!--#INCLUDE FILE="inc_func_secure.asp"-->
<%
If Session(strCookieURL & "Approval") <> "15916941253" Then
	scriptname = split(request.servervariables("SCRIPT_NAME"),"/")
	Response.Redirect "admin_login.asp?target=" & scriptname(ubound(scriptname))
End If
Response.Write  "<table border=""0"" width=""100%"" align=""center"">" & vbNewLine & _
	"	<tr>" & vbNewLine & _
	"		<td width=""33%"" align=""left"" nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
	"		" & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">All Forums</a><br />" & vbNewLine & _
	"		" & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""admin_home.asp"">Admin Section</a><br />" & vbNewLine & _
	"		" & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Group Mailer<br /></font></td>" & vbNewLine & _
	"	</tr>" & vbNewLine & _
	"</table><br /><br />" & vbNewLine
If lcase(strEmail) <> "1" Then
	Response.Write	"<p><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHiLiteFontColor & """>You do not have E-mail enabled.</font></p>" & vbNewLine
	WriteFooter
	Response.End
End If
dim strGroup, intGroup, strTable
strTable = strTablePrefix & "USERGROUPS"
If Request.Form("Method_Type") = "Send_EMail" Then
	Err_Msg = ""
	txtSubject = trim(Request.Form("Subject"))
	txtMessage = trim(Request.Form("Message"))
	If txtSubject = "" Then
		Err_Msg = "<li>You must enter a subject.</li>"
	End If
	If txtMessage = "" Then
		Err_Msg = Err_Msg & "<li>You must enter a message.</li>"
	End If
	If Err_Msg = "" Then
		If (TableExists(strTable) and Request.Form("UserGroup") > "0") Then
			intGroup = Request.Form("UserGroup")
			strSql = "SELECT USERGROUP_NAME FROM " & strTablePrefix & "USERGROUPS WHERE USERGROUP_ID = " & intGroup
			Set rsGroups = my_Conn.Execute(strSql)
			If NOT rsGroups.EOF Then
				strGroups=rsGroups("USERGROUP_NAME")
				rsGroups.Close
			End If
			Set rsGroups = Nothing
			strSql = "SELECT MEMBER_ID FROM " & strTablePrefix & "USERGROUP_USERS WHERE USERGROUP_ID = " & intGroup
			Set rsGroups = my_Conn.Execute(strSql)
			If NOT rsGroups.EOF Then
				rsGroups.MoveFirst
				Do While NOT rsGroups.EOF
					intMember = rsGroups("MEMBER_ID")
					strSql1 = "SELECT M_NAME, M_EMAIL FROM " & strMemberTablePrefix & "MEMBERS WHERE M_STATUS=1 AND MEMBER_ID=" & rsGroups("MEMBER_ID")
					Set rsMail = my_Conn.Execute(strSql1)
					If not rsMail.EOF Then
						strRecipientsName = rsMail("M_NAME")
						strRecipients = rsMail("M_EMAIL")
						strFromName = strForumTitle
						strFrom = strSEnder
						strSubject = txtSubject
						If Request.Form("emailfooter") = 1 Then
							strMessage = txtMessage & vbNewLine & vbNewLine
							strMessage = strMessage & "----------" & vbNewLine
							strMessage = strMessage & "You received this message from " & strForumTitle & " because you are a member of " & strGroups
							strMessage = strMessage & "Your username is: " & Member_Name & vbNewLine
							strMessage = strMessage & "The forums are located at " & strForumURL & "."
						Else
							strMessage = txtMessage
						End If
						%>
						<!--#INCLUDE FILE="inc_mail.asp" -->
						<%
						rsMail.Close
					End If
					Set rsMail = Nothing
					intMailSent = intMailSent+1
					rsGroups.MoveNext
				Loop
				rsGroups.Close
			End If
			Set rsGroups = Nothing
			Response.Write  "<table align=""center"" width=""50%"" border=""0"" cellpadding=""0"" cellspacing=""0"">" & vbNewLine & _
				"	<tr valign=""middle"">" & vbNewLine & _
				"		<td align=""center"" width=""100%"">" & vbNewLine & _
				"			<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """>Mail sent to " & intMailSent & " " & strGroups & " member"
			If intMailSent = 0 or intMailSent > 1 Then
				Response.Write  "s"
			End If
			Response.Write  "." & vbNewLine & _
				"			</font>" & vbNewLine & _
				"			<meta http-equiv=""Refresh"" content=""5; URL=admin_pop_mail.asp""><br /><br />" & vbNewLine & _
				"			<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><a href=""admin_home.asp"">Return to Admin Home</a>" & vbNewLine & _
				"			</font>" & vbNewLine & _
				"		</td>" & vbNewLine & _
				"	</tr>" & vbNewLine & _
				"</table><br /><br />" & vbNewLine
		Else
			strSql = "SELECT M_NAME, M_EMAIL, M_LEVEL "
			strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS"
			strSql = strSql & " WHERE M_STATUS = " & 1
			If Request.Form("optin") = 1 Then
				strSql = strSql & " AND M_RECEIVE_EMAIL = " & 1
			End If
			Select Case Request.Form("limitmods")
				Case 1
					strSql = strSql & " AND M_LEVEL = " & 2
				Case 2
					strSql = strSql & " AND M_LEVEL = " & 3
				Case 3
					strSql = strSql & " AND M_LEVEL >= " & 2
			End Select
			If Request.Form("strInitial") = 1 Then
				Initial = split("A|B|C|D|E|F","|")
				strSql = strSql & " AND (M_NAME LIKE '" & Initial(0) & "%'"
				For icnt = 1 to ubound(Initial)
					strSql = strSql & " OR M_NAME LIKE '" & Initial(icnt) & "%'"
				Next
				strSql = strSql & ")"
			ElseIf Request.Form("strInitial") = 2 Then
				Initial = split("G|H|I|J|K|L|M","|")
				strSql = strSql & " AND (M_NAME LIKE '" & Initial(0) & "%'"
				For icnt = 1 to ubound(Initial)
					strSql = strSql & " OR M_NAME LIKE '" & Initial(icnt) & "%'"
				Next
				strSql = strSql & ")"
			ElseIf Request.Form("strInitial") = 3 Then
				Initial = split("N|O|P|Q|R|S","|")
				strSql = strSql & " AND (M_NAME LIKE '" & Initial(0) & "%'"
				For icnt = 1 to ubound(Initial)
					strSql = strSql & " OR M_NAME LIKE '" & Initial(icnt) & "%'"
				Next
				strSql = strSql & ")"
			ElseIf Request.Form("strInitial") = 4 Then
				Initial = split("T|U|V|W|X|Y|Z","|")
				strSql = strSql & " AND (M_NAME LIKE '" & Initial(0) & "%'"
				For icnt = 1 to ubound(Initial)
					strSql = strSql & " OR M_NAME LIKE '" & Initial(icnt) & "%'"
				Next
				strSql = strSql & ")"
			End If
			Set rsMail = Server.CreateObject("ADODB.RecordSet")
			rsMail.Open strSql, my_Conn, 0, 1, &H0001
			If rsMail.EOF Then
				recMemberCount = ""
			Else
				allMemberData = rsMail.GetRows(-1)
				recMemberCount = UBound(allMemberData, 2)
			End If
			rsMail.Close
			Set rsMail = Nothing
			Server.ScriptTimeout = 10000
			If recMemberCount <> "" Then
				mM_NAME = 0
				mM_EMAIL = 1
				mM_LEVEL = 2
				Response.Write  "<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>Sending E-Mail</font></p>" & vbNewLine
				For RowCount = 0 to recMemberCount
					Member_Name = allMemberData(mM_NAME,RowCount)
					Member_EMail = allMemberData(mM_EMAIL,RowCount)
					Member_Level = allMemberData(mM_LEVEL,RowCount)
					strRecipientsName = Member_Name
					strRecipients = Member_EMail
					strFromName = strForumTitle
					strFrom = strSEnder
					strSubject = txtSubject
					If Request.Form("emailfooter") = 1 Then
						strMessage = txtMessage & vbNewLine & vbNewLine
						strMessage = strMessage & "----------" & vbNewLine
						strMessage = strMessage & "You received this message from " & strForumTitle & " because you are "
						Select Case Member_Level
							Case 1
								strMessage = strMessage & "a member "
							Case 2
								strMessage = strMessage & "a moderator "
							Case 3
								strMessage = strMessage & "an administrator "
						End Select
						strMessage = strMessage & "of the forums." & vbNewLine
						strMessage = strMessage & "Your username is: " & Member_Name & vbNewLine
						strMessage = strMessage & "The forums are located at " & strForumURL & "."
					Else
						strMessage = txtMessage
					End If
					%>
					<!--#INCLUDE FILE="inc_mail.asp" -->
					<%
				Next
				If recMemberCount = 0 Then
					Response.Write	"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>Sent " & (recMemberCount + 1) & " E-Mail</font></p>" & vbNewLine
				Else
					Response.Write	"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>Sent " & (recMemberCount + 1) & " E-Mails</font></p>" & vbNewLine
				End If
			Else
				Response.Write	"<p><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>No Members found</font></p>" & vbNewLine
			End If
		End If
	Else
		Response.Write	"<p><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHiLiteFontColor & """>There Was A Problem With Your E-mail</font></p>" & vbNewLine & _
			"<table>" & vbNewLine & _
			"	<tr>" & vbNewLine & _
			"		<td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHiLiteFontColor & """><ul>" & Err_Msg & "</ul></font></td>" & vbNewLine & _
			"	</tr>" & vbNewLine & _
			"</table>" & vbNewLine & _
			"<p><font size=""" & strDefaultFontSize & """><a href=""JavaScript:history.go(-1)"">Go Back To Enter Data</a></font></p>" & vbNewLine
	End If
Else
	Response.Write	"<form action=""admin_pop_mail.asp"" method=""Post"" id=""Form1"" name=""Form1"">" & vbNewLine & _
		"	<input type=""hidden"" name=""Method_Type"" value=""Send_EMail"">" & vbNewLine & _
		"	<table align=""center"" border=""0"" width=""70%"" cellspacing=""0"" cellpadding=""0"">" & vbNewLine & _
		"		<tr>" & vbNewLine & _
		"			<td bgcolor=""" & strPopUpBorderColor & """>" & vbNewLine & _
		"				<table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""1"">" & vbNewLine & _
		"					<tr valign=""middle"" height=""40"">" & vbNewLine & _
		"						<td align=""center"" bgColor=""" & strHeadCellColor  & """ noWrap colspan=""2""><font  face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize  & """ color=""" & strHeadFontColor & """><b>Group Mailer</b></font></td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>Subject:</b></font></td>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """><input maxLength=""50"" name=""Subject"" tabindex=""1"" value="""" size=""50""></td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<script language=""JavaScript"">document.Form1.Subject.focus();</script>" & vbNewLine & _
		"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>Message:</b></font></td>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """><textarea cols=""80"" name=""Message"" rows=""10"" tabindex=""2"" wrap=""VIRTUAL""></textarea></td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>User Names:</b></font></td>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><input type=""radio"" class=""radio"" name=""strInitial"" value=""1"">A-F <input type=""radio"" class=""radio"" name=""strInitial"" value=""2"">G-M <input type=""radio"" class=""radio"" name=""strInitial"" value=""3"">N-S <input type=""radio"" class=""radio"" name=""strInitial"" value=""4"">T-Z <input type=""radio"" class=""radio"" name=""strInitial"" value=""5"" checked>All</font></td>" & vbNewLine & _
		"					</tr>" & vbNewLine
	If TableExists(strTable) Then
		Response.Write	"					<tr>" & vbNewLine & _
			"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right"">" & vbNewLine & _
			"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>User Groups:</b>" & vbNewLine & _
			"							</font>" & vbNewLine & _
			"						</td>" & vbNewLine & _
			"						<td bgColor=""" & strPopUpTableColor & """>" & vbNewLine & _
			"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
			"								<input type=""radio""  class=""radio"" name=""UserGroup"" value=""0"" Checked> None" & vbNewLine
		strSql = "SELECT USERGROUP_ID, USERGROUP_NAME FROM " & strTablePrefix & "USERGROUPS ORDER BY USERGROUP_NAME ASC"
		Set rsGroups=my_Conn.Execute(strSql)
		If NOT rsGroups.EOF Then
			rsGroups.MoveFirst
			Do While NOT rsGroups.EOF
				strGroup=rsGroups("USERGROUP_NAME")
				intGroup=rsGroups("USERGROUP_ID")
				Response.Write	"								<input type=""radio""  class=""radio"" name=""UserGroup"" value=""" & intGroup & """> " & strGroup & vbNewLine
				rsGroups.MoveNext
			Loop
			rsGroups.Close
		End If
		Set rsGroups = Nothing
		Response.Write	"							</font>" & vbNewLine & _
			"						</td>" & vbNewLine & _
			"					</tr>" & vbNewLine
	End If
	Response.Write	"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right"">" & vbNewLine & _
		"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><B>Member <br>Level:</B>" & vbNewLine & _
		"							</font>" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """>" & vbNewLine & _
		"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
		"								<input type=""radio"" class=""radio"" name =""limitmods"" value=""0"" checked>All Members.<br>" & vbNewLine & _
		"								<input type=""radio"" class=""radio"" name =""limitmods"" value=""1"">Moderators Only<br>" & vbNewLine & _
		"								<input type=""radio"" class=""radio"" name =""limitmods"" value=""2"">Administrators Only<br>" & vbNewLine & _
		"								<input type=""radio"" class=""radio"" name =""limitmods"" value=""3"">Administrators and Moderators" & vbNewLine & _
		"							</font>" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right"">" & vbNewLine & _
		"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """> " & vbNewLine & _
		"							</font>" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """>" & vbNewLine & _
		"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
		"								<input name =""optin"" type=""checkbox"" value=""1"" checked>Check here For opt-in users ONLY. <br />" & vbNewLine & _
		"								<input name =""emailfooter"" type=""checkbox"" value=""1"" checked>Check here to include email footer." & vbNewLine & _
		"							</font>" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ colspan=""2"" align=""center"">" & vbNewLine & _
		"							<input type=""submit"" value=""Send E-Mail"" id=""submit1"" name=""submit1"" tabindex=""3""> " & vbNewLine & _
		"							<input type=""reset"" value=""Reset"" id=""reSet1"" name=""reSet1"" tabindex=""4"">" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"				</table>" & vbNewLine & _
		"			</td>" & vbNewLine & _
		"		</tr>" & vbNewLine & _
		"	</table>" & vbNewLine & _
		"</form>" & vbNewLine
End If
WriteFooter
Response.End

Function TableExists(TabletoFind)
	TableExists = False
	Set adoxConn = CreateObject("ADOX.Catalog")
	Set adodbConn = Server.CreateObject("ADODB.Connection")
	adodbConn.Open(strConnString)
	adoxConn.activeConnection = adodbConn
	IsThere = False
	For each table in adoxConn.tables
		If lcase(table.name) = lcase(TabletoFind) Then
			IsThere = True
			Exit For
		End If
	Next
	adodbConn.Close
	Set adodbConn = Nothing
	Set adoxConn = Nothing
	If IsThere Then TableExists = True
End Function
%>
Edited by - Carefree on 11 November 2011 12:37:06
Go to Top of Page
  Previous Topic Topic Next Topic  
 New Topic  Reply to Topic
 Printer Friendly
Jump To:
Snitz Forums 2000 © 2000-2021 Snitz™ Communications Go To Top Of Page
This page was generated in 0.21 seconds. Powered By: Snitz Forums 2000 Version 3.4.07