Link to home
Start Free TrialLog in
Avatar of UName10
UName10Flag for United Kingdom of Great Britain and Northern Ireland

asked on

Database Error: Microsoft VBScript runtime error '800a000d' Type mismatch: '[string: ""]'

I'm getting the error on this page here, where I added the start time and end times:
Microsoft VBScript runtime error '800a000d'

Type mismatch: '[string: ""]'

/Admin/FranchiseAdmin/CommunityArticles/AddArticle.asp, line 43

Open in new window


<%
	on error resume next
	Set upload = Server.CreateObject("Persits.Upload")
	upload.CodePage = 65001
	upload.save
	on error goto 0
%>
<!--#include virtual="/System/Startup_Admin.asp"-->
<!--#include virtual="/Admin/FranchiseAdmin/ContentEditor/i_EditContent.asp"-->
<%
getrs rs,"SELECT * FROM CommunityArticles WHERE ca_franchise = '"&session("AdminFranchiseGID")&"' AND ca_id = '"&cint(request.querystring("delarticle"))&"';",""

if ""&request.querystring("action") = "add" then
	
	path = server.MapPath("/LiveStorage/Uploads/image/CommunityArticles/")&"\"
	set file = upload.files("thumbimg")
	if not file is nothing then
		thumbfile = getguid & file.ext
		file.saveas path&thumbfile
	end if
	
	set file = upload.files("fullimg")
	if not file is nothing then
		fullimg = getguid & file.ext
		file.saveas path&fullimg
	end if
	
	set sql = new sql_insert
	with sql
		.table = "CommunityArticles"
		.addparam "ca_franchise",Session("AdminFranchiseGID"),""
		.addparam "ca_title",trim(""&getform("title")),""
		.addparam "ca_location",trim(""&getform("location")),""
		.addparam "ca_address1",trim(""&getform("address1")),""
		.addparam "ca_address2",trim(""&getform("address2")),""
		.addparam "ca_town",trim(""&getform("town")),""
		.addparam "ca_county",trim(""&getform("county")),""
		.addparam "ca_postcode",trim(""&getform("postcode")),""
		.addparam "ca_category","",cint(""&getform("category"))		
		.addparam "ca_startdate","","'"&getform("startdate_Day") & " " & monthname(getform("startdate_Month")) & " " & getform("startdate_Year")&"'"
		.addparam "ca_enddate","","'"&getform("enddate_Day") & " " & monthname(getform("enddate_Month")) & " " & getform("enddate_Year")&"'"

		.addparam "ca_starttime","","'"&getform("starttime_Hour") & " " & minute(getform("starttime_Min")) & "'"
		.addparam "ca_endtime","","'"&getform("endtime_Hour") & " " & minute(getform("endtime_Min")) & "'"

		.addparam "ca_summary",""&getform("summary"),""
		.addparam "ca_article",""&getform("article"),""
		.addparam "ca_thumbnail",""&thumbfile,""
		.addparam "ca_fullimage",""&fullimg,""
		.run
	end with
	set sql = nothing
	response.redirect "Default.asp"
end if
%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Inside-Guides.co.uk - Community Article Administration</title>
<!--#include virtual="/Assets/Templates/Admin/FranchiseAdmin/HeadCSS.asp"-->
<script type="text/javascript" src="/system/ckeditor/ckeditor.js"></script>
<script type="text/javascript" src="/system/ckeditor/adapters/jquery.js"></script>
<script type="text/javascript">
CKEDITOR.config.width ='550px';
CKEDITOR.config.toolbar = 'Basic';
</script>
<script type="text/javascript">
	$(window).load(function(){
		$('.ckeditor').ckeditor( function() { /* callback code */ }, { toolbar: 'Basic' } );
	});
</script>
</head>
<body>
<!--#include virtual="/Assets/Templates/Admin/FranchiseAdmin/TemplateStart.asp"-->
<br />
<h1><%Response.Write(Session("AdminFranchiseName"))%> Community: Add a New Article</h1>
<br />
<br /><br />
<% If Not Session("Role_Franchise_ManageContent") then AccessDenied %>
<span class="ErrorText"><% = strUserError %></span>
<form name="EditForm" id="EditForm" method="post" action="AddArticle.asp?Action=add" enctype="multipart/form-data">
    <table>
        <tr>
            <th align="left" valign="top" width="200">
                Title:
            </th>
            <th align="left" valign="top">
                <input type="text" name="title" id="title" style="width:97%;" />
            </th>
        </tr>
        <tr>
          <th align="left" valign="top">Location</th>
          <th align="left" valign="top">
          	<input type="text" name="location" id="location" style="width:97%;" />
          </th>
        </tr>

        <tr>
          <th align="left" valign="top">Address 1</th>
          <th align="left" valign="top">
          	<input type="text" name="address1" id="address1" style="width:97%;" />
          </th>
        </tr>

        <tr>
          <th align="left" valign="top">Address 2</th>
          <th align="left" valign="top">
          	<input type="text" name="address2" id="address2" style="width:97%;" />
          </th>
        </tr>

        <tr>
          <th align="left" valign="top">Town</th>
          <th align="left" valign="top">
          	<input type="text" name="town" id="town" style="width:97%;" />
          </th>
        </tr>

        <tr>
          <th align="left" valign="top">County</th>
          <th align="left" valign="top">
          	<input type="text" name="county" id="county" style="width:97%;" />
          </th>
        </tr>

        <tr>
          <th align="left" valign="top">Postcode</th>
          <th align="left" valign="top">
          	<input type="text" name="postcode" id="postcode" style="width:97%;" />
          </th>
        </tr>

        <tr>
          <th align="left" valign="top">Start Date</th>
          <th align="left" valign="top">
          	<% CreateDateSelectionBox "startdate", NOW, False %>
          </th>          
        </tr>
        <tr>
          <th align="left" valign="top">Category</th>
          <th align="left" valign="top">
          	<select name="category" id="category">
            	<option value=""></option>
                <% getrs tmp,"SELECT * FROM CommunityArticleCategories ORDER BY cac_category;",""
				while not tmp.eof %>
                <option value="<%=server.HTMLEncode(""&tmp("cac_id"))%>"><%=server.HTMLEncode(""&tmp("cac_category"))%></option>
                <% tmp.movenext : wend %>
            </select>
          </th>
        </tr>
        
        <tr>
          <th align="left" valign="top">End Date (optional)</th>
          <th align="left" valign="top">
          	<% CreateDateSelectionBox "enddate", NOW, False %>
          </th>
        </tr>

        <tr>
          <th align="left" valign="top">Start Time</th>
          <th align="left" valign="top">
          	<% CreateDateTimeSelectionBox "starttime", NOW, False %>
          </th>          
        </tr>

        <tr>
          <th align="left" valign="top">End Time</th>
          <th align="left" valign="top">
          	<% CreateDateTimeSelectionBox "endtime", NOW, False %>
          </th>          
        </tr>

        <tr>
          <th align="left" valign="top">Summary</th>
          <th align="left" valign="top"> <textarea name="summary" id="summary" style="border:1px solid #888;" maxlength="255"></textarea>
          </th>
        </tr>
        <tr>
          <th align="left" valign="top">Full Article</th>
          <th align="left" valign="top">
          	<textarea name="article" class="ckeditor" rows="40" id="article" style="border:1px solid #888;"></textarea>
<script type="text/javascript">
    CKEDITOR.replace( 'article',
    {
        toolbar : 'article',
    });
</script>
          </th>
        </tr>
        <tr>
          <th align="left" valign="top">Thumbnail Image</th>
          <th align="left" valign="top">          
          	<input type="file" name="thumbimg" id="thumbimg" />
          </th>
        </tr>
        <tr>
          <th align="left" valign="top">Full Image</th>
          <th align="left" valign="top">          
          	<input type="file" name="fullimg" id="fullimg" />
          </th>
        </tr>
        <tr>
            <th align="left" valign="top"></th>
            <th align="left" valign="top">
                <br />
                <a style="padding:0 1em;" href="javascript:document.getElementById('EditForm').submit();"><% = GetIcon("OK", "Save Changes", 40, True) %>&nbsp;Save Changes</a>
                <a style="padding:0 1em;" href="javascript:document.location='Default.asp?PGID=<% = Request("PGID") %>';"><% = GetIcon("Delete", "Cancel Changes", 40, True) %>&nbsp;Cancel</a>
                <a style="padding:0 1em;" href="javascript:window.parent.location.reload(true);"><% = GetIcon("Undo", "Undo Changes", 40, True) %>&nbsp;Undo</a>
            </td>
        </tr>
    </table>
</form>

<br />
<!--#include virtual="/Assets/Templates/Admin/FranchiseAdmin/TemplateEnd.asp"-->
</body>
</html>
<!--#include virtual="/System/Shutdown.asp"-->

Open in new window

Avatar of Robert Schutt
Robert Schutt
Flag of Netherlands image

minute() expects a Date or Time as argument, you probably need to remove those calls altogether. So line 43/44 become:
		.addparam "ca_starttime","","'"&getform("starttime_Hour") & " " & getform("starttime_Minute") & "'"
		.addparam "ca_endtime","","'"&getform("endtime_Hour") & " " & getform("endtime_Minute") & "'"

Open in new window

On the other hand, you may need to make sure it's always 2 digits?
Avatar of UName10

ASKER

Hi there, thanks for the suggestion.

I just tried it and I'm getting the following error:

Microsoft OLE DB Provider for SQL Server error '80040e07'

Conversion failed when converting character string to smalldatetime data type.

/includes/functions.asp, line 355

The field's set to smalldatetime in the table, so that's ok..

Here's where it further down the page:

        <tr>
          <th align="left" valign="top">Start Time</th>
          <th align="left" valign="top">
          	<% CreateDateTimeSelectionBox "starttime", NOW, False %>
          </th>          
        </tr>

        <tr>
          <th align="left" valign="top">End Time</th>
          <th align="left" valign="top">
          	<% CreateDateTimeSelectionBox "endtime", NOW, False %>
          </th>          
        </tr>

Open in new window


Here's the functions.asp code it's referring to just in case you can spot it:

<%
constr = strConn

function IIf (boolValue, varTrue, varFalse)  ' Inline If
  if boolValue then IIf = varTrue else IIf = varFalse
end function

function sqlsafe(svar)
	sqlsafe = svar'replace(svar,"'","\'")
end function

function urlsafe(surl)
	urlsafe = ""
	if len(""&surl) > 0 then
		safechars = "abcdefghijklmnopqrstuvwxyz-0123456789"
		surl = replace(surl," ","-")
		surl = lcase(surl)
		for i = 1 to len(surl)
			if instr(safechars,mid(surl,i,1)) > 0 then urlsafe = urlsafe & mid(surl,i,1)
		next
	end if
end function

function getquery(qvar)
	getquery = sqlsafe(request.querystring(qvar))
end function

function getform(fvar)
	getform = ""
	if isobject(upload) then
		for each Item in upload.form 
			if Item.name = fvar then 
				if len(""&getform)>0 then getform = getform & "," & item.value else getform = item.value
			end if
		next
	else
		getform = sqlsafe(request.form(fvar))
	end if
end function

function pagetostring(theurl)
	set xml = server.createobject("Microsoft.XMLHTTP")
	xml.open "GET",theurl,False,"adc","pathways1"
	xml.send
	pagetostring = xml.responsetext
	set xml = nothing
end function

sub callpage(theurl)
	set cpxml = server.createobject("MSXML2.ServerXMLHTTP")
	cpxml.open "GET",theurl,False,"adc","pathways1"
	cpxml.send
	set cpxml = nothing
end sub

Function ExtractFilename( Path )
	Dim Pos
	Pos = InStrRev(Path,"\")
	If Pos = 0 Then Pos = InStrRev(Path,"/")
	If Pos = 0 Then Pos = InStrRev(Path,":")
	If Pos = 0 Then 
		ExtractFilename = Path
	Else
		ExtractFilename = Right(Path,Len(Path)-Pos)
	End If
End Function

Function stripHTML(strHTML)
'Strips the HTML tags from strHTML

  Dim objRegExp, strOutput
  Set objRegExp = New Regexp

  objRegExp.IgnoreCase = True
  objRegExp.Global = True
  objRegExp.Pattern = "<(.|\n)+?>"

  'Replace all HTML tag matches with the empty string
  strOutput = objRegExp.Replace(strHTML, "")
  
  'Replace all < and > with &lt; and &gt;
  strOutput = Replace(strOutput, "<", "&lt;")
  strOutput = Replace(strOutput, ">", "&gt;")
  
  stripHTML = strOutput    'Return the value of strOutput

  Set objRegExp = Nothing
End Function

sub addtoarray(thearray,thevalue)
	if isarray(thearray) then
		oldcount = ubound(thearray)
		newcount = oldcount + 1
		redim preserve thearray(newcount)
		thearray(newcount) = thevalue
	else
		thearray = array(thevalue)
	end if
end sub

function arraysearch(asarray,asvalue)
	arraysearch = -1
	if isarray(asarray) then
		for ars = 0 to ubound(asarray)
			if ""&trim(asarray(ars)) = ""&asvalue then
				arraysearch = ars
				exit function
			end if
		next
	end if
end function

function arraytostring(ats)
	if isarray(ats) then
		for iats = 0 to ubound(ats)
			arraytostring = arraytostring & iats & " = " & ats(iats) & ", "
		next
	else
		arraytostring = "Not array"
	end if
end function

function getguid()
	getguid = server.createobject("scriptlet.typelib").guid
	getguid = replace(getguid,"}","")
	getguid = replace(getguid,"{","")
	getguid = replace(getguid,"-","")
	getguid = server.HTMLEncode(getguid)
end function

function showalert(sError,sURL)
	response.write "<script>"&vbcrlf
	response.write "alert('"&replace(sError,"'","\'")&"');"&vbcrlf
	if len(""&sURL) = 0 then
		response.write "window.history.go(-1);"&vbcrlf
	else
		response.write "window.location.href='"&sURL&"';"&vbcrlf
	end if
	response.write "</script>"&vbcrlf
	if len(""&sURL) = 0 then
		response.write "<input type='button' value='Back' onclick='window.history.go(-1);'>"
	else
		response.write "<input type='button' value='Continue' onclick=""window.location.href='"&sURL&"'"">"
	end if
	
end function

function isemail(email)
	isemail = true
	if instr(email,"@") = 0 then isemail = false
	if instr(email,".") = 0 then isemail = false
end function

sub getrs(grs,gsql,gparams)
	set gcom = server.createobject("adodb.command")
	gcom.activeconnection = constr
	gcom.commandtext = gsql
	gcom.prepared = true
	
	if isarray(gparams) then
		for gi = 0 to ubound(gparams)
			gcom.parameters.append gcom.createparameter("p"&gi,12,1,65535,gparams(gi))
		next
	end if
	'response.write gsql
	set grs = server.CreateObject("adodb.recordset")
	grs.cursortype = 1
	grs.open gcom
end sub

function getcount(grs)
	getcount = 0
	while not grs.eof
		getcount = getcount+1
	grs.movenext
	wend
	grs.requery
end function

class sendmail
	Public fromaddr
	Public toaddr
	Public cc
	Public bcc
	Public subject
	Public body
	Public attach
	Public htmlbody
	Public replyto
	
	Public sub send()
		Set em=CreateObject("CDO.Message")
		em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
		em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "127.0.0.1"
		em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 0
		em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
		em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False)
		em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
		em.Configuration.Fields.Update
		em.Subject=subject
		em.From=fromaddr
		em.To=toaddr
		
		if len(""&cc) > 0 then em.Cc=cc
		if len(""&bcc) > 0 then em.Bcc=bcc
		if len(""&body) > 0 then
			em.TextBody=body
		end if
		
		if len(""&replyto) > 0 then em.replyto = replyto
		
		if len(""&htmlbody) > 0 then
			em.HTMLBody = htmlbody
		end if
		
		if len(""&attach) > 0 then
			set fs = server.createobject("scripting.filesystemobject")
			arrA = split(attach,",")
			for a = 0 to ubound(arrA)
				if fs.fileexists(arrA(a)) then em.AddAttachment arrA(a)
			next
			set fs = nothing
		end if
		
		em.Send
		set em=nothing
	end sub
end class

function getAge(dtDOB)
	dim iAge, dtTmp, dtToday
	dtToday = Date()
	iAge = CInt(DateDiff("yyyy",FormatDateTime(dtDOB,1),Date()))
	dtTmp = CDate((Day(dtDOB) & "/" & Month(dtDOB) & "/" & Year(Date())))
	if (dtTmp > Date) then iAge = iAge - 1
	getAge = iAge
end function

function makepassword(plength)
	chars = "abcdefghjkmnpqrstuvwxyz23456789"
	randomize()
	ul = len(chars)
	for p = 1 to plength
		makepassword = makepassword & mid(chars,int(ul*Rnd()+1),1)
	next
end function

function makejsid() 
	chars = "abcdefghijklmnopqrstuvwxyx"
	nums  = "0123456789"
	randomize()
	for i = 0 to 2
		makejsid = makejsid & mid(chars,int(len(chars)*Rnd()+1),1)
	next
	for i = 0 to 3
		makejsid = makejsid & mid(nums,int(len(nums)*Rnd()+1),1)	
	next
	makejsid = ucase(makejsid)
end function

sub addtosql(thearray,thekey,thevalue,thedest)
	if isarray(thearray) then
		oldcount = ubound(thearray,2)
		newcount = oldcount + 1
		redim preserve thearray(2,newcount)
		thearray(0,newcount) = thekey
		thearray(1,newcount) = thevalue
		thearray(2,newcount) = thedest
	else
		execute("Dim thearray()")
		redim thearray(2,0)
		thearray(0,0) = thekey
		thearray(1,0) = thevalue
		thearray(2,0) = thedest
	end if
end sub

sub exesql(esql,eparams)
	set com = server.createobject("adodb.command")
	com.activeconnection = constr
	com.commandtext = esql
	com.prepared = true
	if isarray(eparams) then
		for ei = 0 to ubound(eparams)
			'response.write ei & " = " & eparams(ei)&"<br>"
			com.parameters.append com.createparameter("param"&ei,201,1,65535,eparams(ei))
		next
	end if
	com.execute
	set com = nothing
end sub

function getColumnType(ct,cc)
	getrs gr,"SELECT "&cc&" FROM " & ct,""
	'response.write cc
	getColumnType = gr.fields(0).type
	gr.close
	set gr = nothing
end function

Class sql_insert
	'set temp = new sql_insert
	'temp.table = "s_security"
	'temp.addparam "s_username","fish",""
	'temp.addparam "s_password","cod",""
	'temp.run
	'set temp = nothing

	private sip
	private sis
	private sia
	private t
	
	public sub addparam(pcol,pval,psrc)
		addtosql sip,pcol,pval,psrc
	end sub
	
	public property let table(st)
		t = st
	end property
	
	sub run
		for i = 0 to ubound(sip,2)
			'add column
			 a=a&sip(0,i)&","
			'add value
			if len(""&sip(2,i)) = 0 then
				b=b&"?,"
				addtoarray sia,sip(1,i)
				addtoarray inscols,sip(0,i)
			else
				b=b&sip(2,i)&","
				if instr(sip(2,i),"?")>0 then 
					addtoarray sia,sip(1,i)
					addtoarray inscols,sip(0,i)
				end if
			end if
		next
		
		a=left(a,len(a)-1)
		b=left(b,len(b)-1)
				
		sis = "INSERT INTO "&t&" ("&a&") VALUES ("&b&")"
		
		set com = server.createobject("adodb.command")
		com.activeconnection = constr
		com.commandtext = sis
		com.prepared = true
		if isarray(sia) then
		for i = 0 to ubound(sia)
			'response.write inscols(i) & " = " & sia(i) & " - " & getColumnType(t,inscols(i)) & "<br>"
			com.parameters.append com.createparameter("param"&i,getColumnType(t,inscols(i)),1,65535,sia(i))
		next
		end if
		com.execute
		set com = nothing

	end sub
end class

Class sql_update
'set temp = new sql_update
'temp.table = "s_security"
'temp.where "WHERE s_username='fish2'",""
'temp.addparam "s_username","fish22",""
'temp.addparam "s_password","cod22",""
'temp.run
'set temp = nothing

	private params
	private arrsql
	private t
	private wheresql
	private whereval
	private wherestr
	
	public sub addparam(pcol,pval,psrc)
		addtosql arrsql,pcol,pval,psrc
	end sub
	
	public property let table(st)
		t = st
	end property
	
	public sub where(whsql,whval)
		addtoarray wheresql, whsql
		addtoarray whereval, whval
	end sub
	
	public property let wherestring(whst)
		wherestr = whst
	end property
	
	public sub run
		sus = "UPDATE "&t&" SET "
		for i = 0 to ubound(arrsql,2)
			sus = sus & arrsql(0,i)&"="
			if len(""&arrsql(2,i)) = 0 then
				sus=sus&"?,"
				addtoarray sua,arrsql(1,i)
				addtoarray updatecols,arrsql(0,i)
			else
				sus=sus&arrsql(2,i)&","
			end if
		next
		
		sus=left(sus,len(sus)-1)
		
		if isarray(wheresql) then
			for i = 0 to ubound(wheresql)
				if instr(sus,"WHERE") = 0 then 
					sus = sus & " WHERE "
				else
					sus = sus & " AND "
				end if
				sus=sus&" "&wheresql(i)&" = ? "

				addtoarray sua,whereval(i)
				addtoarray updatecols,wheresql(i)
			next
		end if
		
		if len(""&wherestr) > 0 then
			sus = sus & wherestr
		end if
		
		';exesql sus,sua
		set com = server.createobject("adodb.command")
		com.activeconnection = constr
		com.commandtext = sus
		com.prepared = true
		for i = 0 to ubound(sua)
			com.parameters.append com.createparameter("param"&i,getColumnType(t,updatecols(i)),1,65535,sua(i))
		next
		com.execute
		set com = nothing
		
		
	end sub
end class

function randomnumber(rmin,rmax)
	randomize
	randomnumber = int((rmax-rmin+1)*rnd+rmin)
end function
%>

Open in new window



Many thanks for the help.
ASKER CERTIFIED SOLUTION
Avatar of Robert Schutt
Robert Schutt
Flag of Netherlands image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of UName10

ASKER

That worked great - many thanks for the help.
Avatar of UName10

ASKER

Just one quick question if that's ok; do you know how I can remove the date (day and month) from the starttime and endtime options?

The format is currently: Day, Month, Year, Hour, Minute

But I'd like it to just be Hour & Minute if possible..

Many thanks.
Inside the database? You probably could use a time type but I'm not sure how that would affect the code. On the page, it probably needs some tweaking to the function CreateDateTimeSelectionBox but that's not in your posted code, probably in one of the other includes.
Avatar of UName10

ASKER

Hello, yep the database is fine; just the time, it's this include file I believe with the CreateTimeDateSelectionBox function; I'm just not sure how best to tweak it...

Shall I open a new one for it and award points?

Here's the code for the time and date funcitons (first one is the time and date one):

If you had any ideas it's be great as I haven't been able to change it successfully..

Many thanks:

<%
Sub CreateSelectOption(byVal Value, byVal Display, byVal CurrentValue)
    %><option value="<% = Value %>" <% = GetSelectStatus_FromValues(Value,CurrentValue) %>><% = Display %></option><%
End Sub

Public Sub CreateDateTimeSelectionBox(strObjectName, dtCurrentDateTime, AllowNone)
    Dim iHour
    Dim iMin
    Dim i
    Dim strSelected
    if dtCurrentDateTime = "0" then
        dtCurrentDateTime = Now()
    end if
    If IsNull(dtCurrentDateTime) then
        iHour = ""
        iMin = ""
    Else
        dtCurrentDateTime = CDate(dtCurrentDateTime)
        iHour = Hour(dtCurrentDateTime)
        iMin = Minute(dtCurrentDateTime)
    End If
    CreateDateSelectionBox strObjectName, dtCurrentDateTime, AllowNone
    %>
    <select name="<% = strObjectName %>_Hour" class="input-list">
        <%
        If AllowNone = True then
            %><option value=""> - </option><%
        End if
        For i = 0 to 23
            if i = iHour then
                strSelected = " SELECTED "
            Else
                strSelected = ""
            end if
            %><option value="<% = Right("00" & Trim(CStr(i)), 2) %>" <% = strSelected %>><% = Right("00" & Trim(CStr(i)), 2) %></option><%
        Next
        %>
    </select>
    <select name="<% = strObjectName %>_Min" class="input-list">
        <%
        If AllowNone = True then
            %><option value=""> - </option><%
        End if
        For i = 0 to 59
            if i = iMin then
                strSelected = " SELECTED "
            Else
                strSelected = ""
            end if
            %><option value="<% = Right("00" & Trim(CStr(i)), 2) %>" <% = strSelected %>><% = Right("00" & Trim(CStr(i)), 2) %></option><%
        Next
        %>
    </select>
    <%
End Sub

Public Sub CreateDateSelectionBox(strObjectName, dtCurrentDate, AllowNone)
	Dim iDay
	Dim iMonth
	Dim iYear
	Dim iYearCount
	Dim strSelected
	Dim i
	if dtCurrentDate = "0" then
		dtCurrentDate = Date()
	end if
	
	if len(""&dtCurrentDate) > 0 then
	    iDay = Day(dtCurrentDate)
	    iMonth = Month(dtCurrentDate)
	    iYear = Year(dtCurrentDate)
	else
		iDay = 0
		iMonth = 0
		iYear = 0
	end if
	%>
	<select name="<% = strObjectName %>_Day" ID="Select1" class="input-list">
		<%
		If AllowNone = True then
		    %><option value=""> - </option><%
		end if
		For i = 1 to 31
			if i = iDay then
				strSelected = " SELECTED "
			else
				strSelected = ""
			end if
			%><option value="<% = i %>"<% = strSelected %>><% = i %></option><%
		Next
		%>
	</select>
	<select name="<% = strObjectName %>_Month" ID="Select2" class="input-list">
		<%
		If AllowNone = True then
		    %><option value=""> - </option><%
		end if
		For i = 1 to 12
			if i = iMonth then
				strSelected = " SELECTED "
			else
				strSelected = ""
			end if
			%><option value ="<% = i %>"<% = strSelected %>><% = MonthName(i) %></option><%
		Next
		%>
	</select>
	<select name="<% = strObjectName %>_Year" ID="Select3" class="input-list">
		<%
		If AllowNone = True then
		    %><option value=""> - </option><%
		end if
		loopyear = iyear
		if loopyear = 0 then loopyear = year(now)
            For i = Year(Now) - 1 To Year(Now) + 10
			if i = iYear then
				strSelected = " SELECTED "
			else
				strSelected = ""
			end if
			%><option value="<% = i %>"<% = strSelected %>><% = i %></option><%
		Next
		%>
	</select>
	<%
End Sub

Public Sub CreateCCDateSelectionBox(strObjectName, dtCurrentDate, AllowNone, IsFromDate)
	Dim iDay
	Dim iMonth
	Dim iYear
	Dim iYearCount
	Dim strSelected
	Dim iYearStart
	Dim iYearEnd
	Dim i
	if dtCurrentDate = "0" then
		dtCurrentDate = Date()
	end if
	if IsNull(dtCurrentDate) then
	    iDay = ""
	    iMonth = ""
	    iYear = ""
'	    iYear = Year(Date())
	    iYearCount = Year(Date())
	else
	    iDay = Day(dtCurrentDate)
	    iMonth = Month(dtCurrentDate)
	    iYear = Year(dtCurrentDate)
	    iYearCount = iYear
	end if
	If IsFromDate = True then
	    iYearStart = iYearCount - 1
	    iYearEnd = Year(Date())
	Else
	    iYearStart = Year(Date())
	    iYearEnd = iYearCount + 10
	End if
	%>
	<input type="hidden" name="<% = strObjectName %>_Day" value="1" />
	<select name="<% = strObjectName %>_Month" ID="Select5" class="input-list">
		<%
		If AllowNone = True then
		    %><option value=""> - </option><%
		end if
		For i = 1 to 12
			if i = iMonth then
				strSelected = " SELECTED "
			else
				strSelected = ""
			end if
			%><option value ="<% = i %>"<% = strSelected %>><% = Right("00" & Trim(CStr(i)), 2) %></option><%
		Next
		%>
	</select> / 
	<select name="<% = strObjectName %>_Year" ID="Select6" class="input-list">
		<%
		If AllowNone = True then
		    %><option value=""> - </option><%
		end if
		For i = iYearStart to iYearEnd
			if i = iYear then
				strSelected = " SELECTED "
			else
				strSelected = ""
			end if
			%><option value="<% = i %>"<% = strSelected %>><% = Right(i, 4) %></option><%
		Next
		%>
	</select>
	<%
End Sub

Public Function GetFormDate(byVal strObjectName)
	Dim sDate
	if IsNull(Request(strObjectName & "_Day")) or IsNull(Request(strObjectName & "_Month")) or IsNull(Request(strObjectName & "_Year")) then
		sDate = Null
	elseif Trim(CStr(Request(strObjectName & "_Day"))) = "0" or Trim(CStr(Request(strObjectName & "_Month"))) = "0" or Trim(CStr(Request(strObjectName & "_Year"))) = "0" then
		sDate = Null
	elseif Trim(CStr(Request(strObjectName & "_Day"))) = "" or Trim(CStr(Request(strObjectName & "_Month"))) = "" or Trim(CStr(Request(strObjectName & "_Year"))) = "" then
		sDate = Null
	else
		sDate = CleanResponseText(Request(strObjectName & "_Day")) & " " & MonthName(CleanResponseText(Request(strObjectName & "_Month"))) & " " & CleanResponseText(Request(strObjectName & "_Year"))
	end if
	If IsDate(sDate) then
		GetFormDate = sDate
	else
		GetFormDate = Null
	end if
End Function

Public Function GetFormDateTime(byVal strObjectName)
	Dim sDate
	if IsNull(Request(strObjectName & "_Day")) or IsNull(Request(strObjectName & "_Month")) or IsNull(Request(strObjectName & "_Year"))  or IsNull(Request(strObjectName & "_Hour")) or IsNull(Request(strObjectName & "_Min")) then
		sDate = Null
	elseif Trim(CStr(Request(strObjectName & "_Day"))) = "0" or Trim(CStr(Request(strObjectName & "_Month"))) = "0" or Trim(CStr(Request(strObjectName & "_Year"))) = "0" then
		sDate = Null
	elseif Trim(CStr(Request(strObjectName & "_Day"))) = "" or Trim(CStr(Request(strObjectName & "_Month"))) = "" or Trim(CStr(Request(strObjectName & "_Year"))) = "" or Trim(CStr(Request(strObjectName & "_Hour"))) = "" or Trim(CStr(Request(strObjectName & "_Min"))) = "" then
		sDate = Null
	else
		sDate = CleanResponseText(Request(strObjectName & "_Day")) & " " & MonthName(CleanResponseText(Request(strObjectName & "_Month"))) & " " & CleanResponseText(Request(strObjectName & "_Year")) & " " & CleanResponseText(Request(strObjectName & "_Hour")) & ":" & CleanResponseText(Request(strObjectName & "_Min"))
	end if
	If IsDate(sDate) then
		GetFormDateTime = sDate
	else
		GetFormDateTime = Null
	end if
End Function

Public Function StartHoverClickDiv(byVal strText)
	Dim sDivStream
	Dim strTitle
	Dim strAlert
	' Sort out the LineBreaks for JS and HTML
	strTitle = strText
	strAlert = strText
	strTitle = Replace(strTitle, "<br>", vbCrLf)
	strTitle = Replace(strTitle, "\n", vbCrLf)
	strAlert = Replace(strAlert, "<br>", "\n")
	strAlert = Replace(strAlert, vbCrLF, "\n")
	' Sort out JS {'} Quote problem
	strTitle = Replace(strTitle, "'", "\'")
	strTitle = Replace(strTitle, """", "\'")
	strAlert = Replace(strAlert, "'", "\'")
	strAlert = Replace(strAlert, """", "\'")
	sDivStream = "<div title=""" & strTitle & """ onClick=""javascript:alert('" & strAlert & "');"" style=""cursor: help;"">"
	StartHoverClickDiv = sDivStream
End Function

Public Function StartHoverDiv(byVal strText)
	Dim sDivStream
	Dim strTitle
	' Sort out the LineBreaks for JS and HTML
	strTitle = strText
	strTitle = Replace(strTitle, "<br>", vbCrLf)
	strTitle = Replace(strTitle, "\n", vbCrLf)
	' Sort out JS {'} Quote problem
	strTitle = Replace(strTitle, "'", "\'")
	strTitle = Replace(strTitle, """", "\'")
	sDivStream = "<div title=""" & strTitle & """ style=""cursor: help;"">"
	StartHoverDiv = sDivStream
End Function

Public Function MakeJavaSafeText(byVal Message)
    Message = Replace(Message, "\", "\\")
    Message = Replace(Message, "\\n", "\n")
    Message = Replace(Message, "<br>", "\n")
    Message = Replace(Message, vbCrLf, "\n")
    MakeJavaSafeText = Message
End Function

Public Sub DoJavaAlert(byVal Message)
    %>
    <script language="javascript" type="text/javascript">
        <!--
            alert('<% = MakeJavaSafeText(Message) %>');
        //-->
    </script>
    <%
End Sub
Public Sub DoJavaRedirect(byVal URL)
    %>
    <script language="javascript" type="text/javascript">
        <!--
            document.location='<% = URL %>';
        //-->
    </script>
    <%
End Sub
%>

Open in new window

Avatar of UName10

ASKER

Hi Robert, I just added a new question if you'd like to take a look and can award points separately for you:

https://www.experts-exchange.com/questions/28009786/Help-tweaking-a-function-for-a-time-and-date-option-select.html

Cheers.
Avatar of UName10

ASKER

** Dupe comment
No it's ok, no problem to look at it here.

You could copy the function and take out the date part, then call that copy when you want only the time.

Or, based on the fields you call it with in the page, you could change line 22 to (untested):
If InStr(strObjectName, "date") = 0 And InStr(strObjectName, "time") > 0 Then
    CreateDateSelectionBox strObjectName, dtCurrentDateTime, AllowNone
End If

Open in new window

Maybe a better check could be:
If Not Date(dtCurrentDateTime) = #1/1/1900# Then

Open in new window

But that would need some checking.

EDIT: forget that last part, I thought it was being called with the current value from the database, but it isn't.
Oh, hadn't seen you already posted. I'll post a proposed implementation for the first option there.