Hello!
Welcome to my humble website. My name is Levi Lentz and I am currently a SM Student
at the Massachusetts Institute of Technology. I have created this website to catalog
various things that I have done from my journey from San Diego State University to
present. You will find various projects, opinions, photos, and humor scattered throughout.
This site is definately a work in progress, and I am by no means a web developer anymore.
If you have any questions or would like to contact me for any reason, please see the contact page.
Hope to hear from you soon,
Levi
As you may have guessed, my name is Levi Lentz and this page is meant to give you an overview of who I am, where I come from, and where I am going. It is by no means a strict account of everything, but rather a primer for anyone who may have intentionally or unintentionally stumbled across this website. Enjoy.
I was born on July 4th, 1989, in beautiful San Diego, California. I was raised by my father, Kirk Lentz, along with one full brother, Dillon Lentz. My parents were married early on, but due to extramarital affairs by my mother, they were divorced by the time I was 7. If it was not for my father, I would not be a person capable of making an entire website for myself. He put me through a private school (Ramona Lutheran) from K-8th grade on a salary of a Dreyer's Salesman. As odd as it may sound, I graduated at the top of my eighth grade class and enrolled at Escondido Charter High School
The program that I was enrolled in was an independent study program. I studied under Mr. Gary Gidner for all four years. The program required courses to be taken at a Community College concurrently with High School Classes. By the time I graduated, I had taken 36 units at Palomar CC. I played two years of Varsity Football, playing starting Full Back and Middle Line Backer. I was scholar player of the year (highest GPA) both years as well as team captain for both years. I was also a bit of a bigger boy back then, weighing in at 260lbs while being 6'1". Through playing sports I ended up losing 20lbs both years to graduate at 220lbs. (I hope that comes up in a trivia night someday.) Because of my academic success and community involvement I ended up graduating at the top of my Class in 2008 whereupon I chose to attend San Diego State University (SDSU) principally because of financial reasons as I had to pay for my own education. Little did I know how much the next four years would have on my life.
Upon attending SDSU I majored in Mechanical Engineering. Over the ensuing four years I would make many friendships and professional bonds that have helped shape my opinion of this world and have blessed me with the beautiful appreciation I have for life. I still look back fondly on those years as the best I have lived thus far.
My first year was rather bland compared to the other three. However, I started working as a computer technician 20 hours/week to pay for school. Luckily, the job was within the College of Engineering at SDSU, so I was able to interact with faculty prior to taking their classes. Near the end of the year I started becoming involved in college organizations which got me out of my shell and start growing within the University. I was accepted into the University Honors Program my second semester, at which point I started becoming extremely involved on campus.
In my second year, I started becoming a sports nut for "The Show" (our student section: http://www.theshowsdsu.com). I also started becoming a part of the campus by joining honor societies and other extracurricular organizations. By my second year I had been initiated into Phi Eta Sigma and Tau Beta Pi. Through my work with Dr. Thomas Impelluso, I also won the Italian Machine Tool Design Award and was sponsored to go to Italy for two weeks with him to learn the Italian design process. That is still the only time I have been outside of the country; I cant wait until I can get out again.
My third year is where everything started coming together. I was President of Tau Beta Pi as well as an officer for The University Honors Program. Our basketball program went an amazing 34-3, making it all the way to the Sweet 16. Naturally, I went with them all the way to Vegas twice as well as Anaheim to witness the Sweet 16 game. By the end of my third year, I had been initiated into three more honor societies: Phi Kapp Phi, Golden Key, and Mortar Board.
In a lot of ways, my fourth year was an extension of my third year: I continued to have academic success while being extremely involved on campus. And our sports teams were making my weekends very enjoyable. I was an officer for The University Honors Program as well as Mortar Board. The biggest single event of the year was being selected Homecoming King for the university. It was, and still is, quite an honor to be selected by a committee to be Homecoming King (an honor given to the person who embodies the student body through their academics and involvement). By the end of my fourth year I was finally initiated into the elusive Phi Beta Kappa honor society and became the first engineer to attain all five honor societies. I graduated at the top of my class with a 4.0 engineering GPA, accepting my enrollment to The Massachusetts Institute of Technology (MIT).
And that is the brief story of how I got to MIT. I am currently studying for a SM degree in Mechanical Engineering with an expected graduation date of June 2014. I am currently doing research into Hybrid-Organic Solar Cells and hope to complete a PhD here. I want to stress that this is written for brevity and excludes the hundred, no, thousands of people who have helped get me to this point in life. If you would like more information or clarification, please feel free to email me.
Currently, I am working at MIT as a Master's Degree candidate in Mechanical Engineering As part of my degree, I am working on hybrid organic-inorganic solar cells. Nearly 100% of current solar technology is based off of silicon-based cells. These have several ecological restraints because of the difficulty of manufacturing a proper silicon solar cell. To ameliorate these issues, scientists and engineers are turning to a new class of solar cell: organic.
Organic solar cells work by using an organic backbone to generate electricity. In technical terms, when the photon hits the solar collector, and exciton is generated. And exciton is merely an electron and a "hole" (or the absence of an electron. When the excited electron travels through the conduction band, electricity can conceivably be generated. The biggest restraint to these cells is their overall efficiency: an abismal 2-5% of incident light can be converted to electricity. My project is working to fix this.
We are exploring using a functional design of the base atomic structure to increase the efficiency. I will fill this in with more information as I get permission and results. We are using Quantum Espresso, Vasp, and various other quantum-modeling programs to compute the atomic structure to create a new, and novel organic solar cell.
Processing your request...Please wait
<%@ LANGUAGE="VBSCRIPT" %> <% ' Script to Verify Student is Registered for Engineering Courses 'Constants for the NameTranslate object. EngineeringDate = #09/15/2011# NonEngineeringDate = #1/15/2011# Const ADS_NAME_INITTYPE_GC = 3 Const ADS_NAME_TYPE_NT4 = 3 Const ADS_NAME_TYPE_1779 = 1 Const ADS_SCOPE_SUBTREE = 2 On error resume next 'On error resume next Sub Sleep(intSeconds) dteStart = Time() dteEnd = DateAdd("s", intSeconds, dteStart) While dteEnd > Time() DoNothing Wend End Sub Sub DoNothing 'While/Wend has quirks when it is empty End Sub ''//This connects to the DB sub verifyuser() set adoConn =Createobject("ADODB.Connection") set adoRS = Createobject("ADODB.Recordset") adoConn.Open "DSN=simfa8" adoRS.ActiveConnection = adoConn sql_select = "SELECT * FROM simfa8 WHERE id = '" & RedID & "'" 'select statement for the RedID set RS = adoConn.Execute(sql_select) 'executes the command and stores it to the table RS if not RS.eof then Found = True FullName = RS("name") LastName = PCase(Left(FullName,(InStrRev(RS("name"),",") - 1))) Name = Split(Mid(FullName,(InStrRev(RS("name"),",") + 1))) if Lastname <> Pcase(flname) then %> Your last name does not match this redid. <% RS.close adoConn.close set RS = nothing set adoConn = nothing set adoRS = nothing Response.end End if If UBound(Name)=0 Then MidInitial = "nmn" Else MidInitial = UCase(Left(Name(1),1)) End if Select Case CLng(RS("major_code")) Case 441001 Major = "Aerospace" Case 441003 Major = "Aerospace" Case 441005 Major = "Aerospace" Case 441070 Major = "Aerospace" Case 442001 Major = "Civil" Case 442002 Major = "Environmental" Case 442005 Major = "Environmental" Case 442010 Major = "Construction" Case 442030 Major = "Construction" Case 442025 Major = "Civil" Case 442075 Major = "Civil" Case 442085 Major = "Civil" Case 442096 Major = "Civil" Case 442095 Major = "Environmental" Case 443001 Major = "Electrical" Case 444001 Major = "Mechanical" Case 444020 Major = "Mechanical" Case 444050 Major = "Mechanical" Case 444070 Major = "Mechanical" Case 445001 Major = "Computer" Case 446001 Major = "Mechanical" Case 446002 Major = "Mechanical" Case 446003 Major = "Mechanical" Case 446004 Major = "Mechanical" Case 447001 Major = "Mechanical" Case 447010 Major = "Mechanical" Case Else Major = "NonEngineering" End Select TempName = Split(LastName) Select Case UBound(TempName) Case 0 LName = TempName(0) Case 1 LName = TempName(0) + TempName(1) Case 2 LName = TempName(0) + TempName(1) + TempName(2) Case 3 LName = TempName(0) + TempName(1) + TempName(2) + TempName(3) End Select UserName = Left(LName,7) & UCase(Left(Name(0),1)) & Right(RedID, 2) Password = LCase(Mid(LName,2,1)) & LCase(Left(LName,1)) & UCase(Mid(Name(0),2,1)) & LCase(Left(Name(0),1))& Mid(RedID, 2, 4) Found = True else Found = False End if If Found <> True Then %> No User Found under this Red ID number <% Response.end Found = FALSE End If RS.close adoConn.close set RS = nothing set adoConn = nothing set adoRS = nothing end sub Sub HomeDir() strHomeFolder = strHome & strUser 'Response.End Set objFSO = CreateObject("Scripting.FileSystemObject") Set objShell = CreateObject("Wscript.Shell") If strHomeFolder <> "" Then If Not objFSO.FolderExists(strHomeFolder) Then 'On error resume next objFSO.CreateFolder strHomeFolder If Err.Number <> 0 Then On Error GoTo 0 'Wscript.Echo "Cannot create: " & strHomeFolder End If On Error GoTo 0 End If 'On error resume next If objFSO.FolderExists(strHomeFolder) Then 'Assign user permission to home folder. intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls "_ & strHomeFolder & " /t /c /g Administrators:F "_ & "SYSTEM:F "_ & strUser & ":F", 2, True) If intRunError <> 0 Then 'Wscript.Echo "Error assigning permissions for user " _ '& strUser & " to home folder " & strHomeFolder calcserror = 1 End If End If End If Set objFSO = Nothing Set objShell = Nothing End Sub Sub JoinGroup() strUserDNS = "CN=" & cName & "," & sOuDomainPath strGroupDNS = "CN=Students,CN=Users,DC=Engineering,DC=sdsu" Set objUser = GetObject("LDAP://" & strUserDNS) Set objGroup = GetObject("LDAP://" & strGroupDNS) objGroup.add(objUser.ADsPath) objGroup.SetInfo Set objUser = Nothing Set objGroup = Nothing End Sub Function PCase(strIn) strOut = "" boolUp = True For i = 1 to Len(strIn) c = Mid(strIn, i, 1) If c = " " or c = "'" or c = "-" then strOut = strOut & c boolUp = True Else If boolUp then tc=UCase(c) Else tc=LCase(c) End If strOut = strOut & tc boolUp = False End If Next PCase = strOut End Function Sub MoveUser() 'On error resume next strTargetOU = "OU=" & Major & ",OU=Students,DC=Engineering,DC=SDSU" strUserDN = "CN=" & displayName & ",OU=" & OU & ",OU=Students,DC=Engineering,DC=SDSU" Set objTargetOU = GetObject("LDAP://" & strTargetOU) Set objUser = GetObject("LDAP://" & strUserDN) objTargetOU.MoveHere objUser.ADsPath, VBNullString strDN = strUserDN 'call Sleep(20) ' ////////////////////////////////////////////////////////////////////////////////// '/all of this just reconnects to the AD to refresh the info in the event of a move// Set oConnection = CreateObject("ADODB.Connection") 'connects to AD Set objCommand = CreateObject("ADODB.Command") 'Sets up the command for AD oConnection.Provider = "ADsDSOObject" 'AD provider oConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = oConnection 'the connection for the command objCommand.Properties("Page Size") = 1000 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 'actual command to sql-select the distinguished name and sAMAccountname fomr AD objCommand.CommandText = _ "SELECT distinguishedName, saMAccountname, displayName, cn FROM 'LDAP://" & DNSDomain &_ "' WHERE objectCategory='user' AND physicalDeliveryOfficeName=" & RedID Set objRecordSet = objCommand.Execute objRecordSet.MoveFirst set oConnection = nothing set objCommand = nothing set objRecordSet = nothing 'call CheckAD_OU1(RedID,Major) Set objUser = Nothing Set objTargetOU = Nothing '/////////////////////////////////////////////////////////////////////////////////// End Sub Function CheckAD_OU(RedID,Major) 'On error resume next err.clear Dim UName, arrPath Set oRootDSE = GetObject("LDAP://RootDSE") DNSDomain = oRootDSE.Get("DefaultNamingContext") 'All of this connects to active directory and selects the name from the active directory Set oConnection = CreateObject("ADODB.Connection") 'connects to AD Set objCommand = CreateObject("ADODB.Command") 'Sets up the command for AD oConnection.Provider = "ADsDSOObject" 'AD provider oConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = oConnection 'the connection for the command objCommand.Properties("Page Size") = 1000 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 'actual command to sql-select the distinguished name and sAMAccountname fomr AD objCommand.CommandText = _ "SELECT distinguishedName, saMAccountname, displayName, cn FROM 'LDAP://" & DNSDomain &_ "' WHERE objectCategory='user' AND physicalDeliveryOfficeName=" & RedID Set objRecordSet = objCommand.Execute if objRecordSet.EOF then checkAD_OU = False set oConnection = nothing set objCommand = nothing set objRecordSet = nothing Exit Function Else objRecordSet.MoveFirst strDN = "" UName = "" arrPath = "" OU = "" CheckAD_OU = False Do Until objRecordSet.EOF strDN = objRecordSet.Fields("distinguishedName").Value UName = objRecordSet.Fields("saMAccountName").Value displayName = objRecordSet.Fields("cn").Value arrPath = Split(strDN, ",") intLength = Len(arrPath(1)) intNameLength = intLength - 3 OU = Right(arrPath(1), intNameLength) If OU <> "" then If LCase(OU) <> LCase(Major) Then change_major = 1 Call MoveUser() CheckAD_OU = True set oConnection = nothing set objCommand = nothing set objRecordSet = nothing Exit Function Else End If End If objRecordSet.MoveNext Loop End If If OU <> "" Then CheckAD_OU = True Else CheckAD_OU = False End If set oConnection = nothing set objCommand = nothing set objRecordSet = nothing End Function Sub RenewResetUserAccount() Set oLDAP = GetObject("LDAP://" & sOuDomainPath) 'Response.End Set oUser = GetObject("LDAP://" & strDN & "") oUser.Put "sAMAccountName", sUserName oUser.SetInfo oUser.DisplayName = cName oUser.physicalDeliveryOfficeName = RedID oUser.FullName = cName 'Display name. oUser.GivenName = fName oUser.userPrincipalName = sUserName & "@engineering.sdsu" oUser.Initials = Initial oUser.Sn = lName oUser.SetPassword Password oUser.Mail = Email oUser.Put("HomeDrive"),"Z" oUser.HomeDirectory = "\\tera\" & Major & "\" & sUsername oUser.LoginScript = "StudentLogOn.vbs" intPwdValue = 0 oUser.Put "PwdLastSet", intPwdValue If Major = "NonEngineering" Then oUser.Description = Major & " " & "Student" Else oUser.Description = Major & " " & "Engineering Student" End If If Major = "NonEngineering" Then oUser.AccountExpirationDate = NonEngineeringDate Else oUser.AccountExpirationDate = EngineeringDate End If oUser.SetInfo Set oUser = Nothing End Sub sub calcs() 'CaclsExcel.vbs 'VBScript to set Home Folder Permission 'Version 1.0 - August 2007 '---------------------------------------------------------' 'Option Explicit 'Create a shell for cmd and CACLS Set objShell = CreateObject("Wscript.Shell") Set objFSO = CreateObject("Scripting.FileSystemObject") strUser = Username strOldUser = Left(Lastname,6) & UCase(MidInitial) & UCase(Left(Name(0),1)) strMajor = Major if change_major = 1 then strOldHome = "\\tera\students\" & OU & "\" & StrOldUser strOldHome1 = "\\tera\students\" & OU & "\" & Username else strOldHome = "\\tera\students\" & strMajor & "\" & StrOldUser end if strNewHomedir = "\\tera\students\" & strMajor & "\" & strUser If objFSO.FolderExists(strOldHome) then ' this checks to make sure the 'old folder doesnt exist, if it does it moves it to the new folder. if objFSO.FolderExists(strNewHomedir) Then 'if the new folder exists already, 'it will just copy the contents from the old one to the new one. Set folder = objfso.GetFolder(strOldHome) 'checks to see file in old directory Set files = folder.Files if files.count = 0 then ' dont do anything if nothing is in there objfso.deletefolder strOldHome else ' something is in the old folder, copy everything strNewHomedir1 = strNewHomedir & "\" 'actually puts directories in the folder stroldcopyfolder = strOldHome & "\*.*" objfso.MoveFile stroldcopyfolder, strNewHomedir1 stroldcopyfolder = strOldHome & "\*" objfso.MoveFolder stroldcopyfolder, strNewHomedir1 if err.number = 0 then objfso.deletefolder strOldHome end if err.clear end if else objFSO.MoveFolder strOldHome , strNewHomedir if err.number = 0 then objfso.deletefolder strOldHome end if err.cler end if ElseIF objFSO.FolderExists(strOldHome1) then 'for when a user is moving majors... if objFSO.FolderExists(strNewHomedir) Then 'if the new folder exists already, 'it will just copy the contents from the old one to the new one. Set folder = objfso.GetFolder(strOldHome1) 'checks to see file in old directory Set files = folder.Files if files.count = 0 then ' dont do anything if nothing is in there 'wscript.echo "No files in old home directory, deleting " & strOldHome objfso.deletefolder strOldHome1 else ' something is in the old folder, copy everything strNewHomedir1 = strNewHomedir & "\" 'actually puts directories in the folder stroldcopyfolder = strOldHome1 & "\*.*" objfso.MoveFile stroldcopyfolder, strNewHomedir1 stroldcopyfolder = strOldHome1 & "\*" objfso.MoveFolder stroldcopyfolder, strNewHomedir1 if err.number = 0 then objfso.deletefolder strOldHome1 end if err.clear end if else objFSO.MoveFolder strOldHome1 , strNewHomedir if err.number = 0 then objfso.deletefolder strOldHome1 end if err.cler end if end if strHome = "\\tera\students\" & strMajor & "\" set objFSO = nothing set objShell = nothing call HomeDir() ' Subroutine to create folder if not already created and set permissions end sub Sub CreateUserAccount(sOUDomainPath, cName, sUsername) On error resume next Set oLDAP = GetObject("LDAP://" & sOuDomainPath) If Err.Number <> 0 Then On Error GoTo 0 'Wscript.Echo "Unable to bind to container: " & sOUDomainPath 'Wscript.Quit End If 'WScript.Echo cName & " " & sUserName Set oUser = oLDAP.Create("user","cn=" & cName) oUser.Put "sAMAccountName", sUserName oUser.SetInfo oUser.AccountDisabled = False oUser.SetInfo If Major = "NonEngineering" Then oUser.Description = Major & " " & "Student" Else oUser.Description = Major & " " & "Engineering Student" End If oUser.physicalDeliveryOfficeName = RedID oUser.FullName = cName 'Display name. oUser.DisplayName = cName oUser.GivenName = fName oUser.userPrincipalName = sUserName & "@engineering.sdsu" oUser.Initials = Initial oUser.Sn = lName oUser.SetPassword Password oUser.Mail = Email oUser.Put("HomeDrive"),"Z" oUser.HomeDirectory = "\\tera\" & Major & "\" & sUsername oUser.LoginScript = "StudentLogOn.vbs" intPwdValue = 0 oUser.Put "PwdLastSet", intPwdValue If Major = "NonEngineering" Then oUser.AccountExpirationDate = NonEngineeringDate Else oUser.AccountExpirationDate = EngineeringDate End If oUser.SetInfo 'Call CreateHomeDirectory() Call JoinGroup() Set oUser = Nothing Set oLDAP = Nothing End Sub sub sendmail() Set ObjSendMail = CreateObject("CDO.Message") 'This section provides the configuration information for the remote SMTP server. 'Send the message using the network (SMTP over the network). ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="attila.sdsu.edu" ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'Use SSL for the connection (True or False) ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 ObjSendMail.Configuration.Fields.Update 'End remote SMTP server configuration section== ObjSendMail.To = Email ObjSendMail.Subject = "College of Engineering User Account Information" ObjSendMail.From = "HelpDesk@engineering.sdsu.edu" body = "College of Engineering
" body = body & "Date: " & DateTime & "
User Account Information
" body = body & "Request: " & Rqst & "
" body = body & "Name: " & FirstName & " " & MidName & " " & LastName & "
" body = body & "RedID Number: " & RedID & "
" body = body & "Major: " & major & "
" body = body & "Email: " & Email & "
" body = body & "Account Request Submitted with the above information
" body = body & "It has been successfully created. To log on, use the following information for the first logon:
" body = body & "Username: " & UserName & "
" ' we are sending a text email.. simply switch the comments around to send an html email instead ObjSendMail.HTMLBody = body 'ObjSendMail.TextBody = "this is the body" ObjSendMail.Send Set ObjSendMail = Nothing End Sub 'On error resume next ' //////////////////////////////////// ' //The code Starts Below here//////// ' //It renews or creates an account // '//////////////////////////////////// Dim RedID, Major, UserName, MidInitial, Password, OU, displayName, FullName, LastName, name, rqst Dim Email, fName, lName, mInitial, cName, sOUDomainPath, strDN, midname, firstname, objsendmail, body Dim formmajor, ffname, flname, fmname, fusername, change_major, calcserror Dim strHomeFolder, strHome, strUser, strMajor, stroldcopyfolder, strNewHomedir1 Dim objFSO, objShell, intRunError, strOldUser, strOldHome, strNewHomedir change_major = 0 calcserror = 0 RedId = trim(Request.form("RedID")) formmajor = trim(request.form("major")) ffname = trim(request.form("FirstName")) flname = trim(request.form("LastName")) fmname = trim(request.form("MiddleName")) fusername = trim(request.form("UserName")) requesttype = trim(request.form("Request")) email = trim(request.form("Email")) call verifyuser() 'connects to Dr. Paolini's server to verify the information, need to use this. fName = Name(0) lName = Lastname Initial = MidInitial If LCase(MidInitial) = "nmn" Then cName = PCase(fName) & " " & PCase(lName) Else cName = PCase(fName) & " " & UCase(Initial) & ". " & PCase(lName) & "" End If sOUDomainPath = "OU=" & Major & ",OU=Students,DC=Engineering,DC=sdsu" sUsername = Username if requesttype = "NA" then If CheckAD_OU (RedID,Major) = True Then %> You already have an account under this RedID, if you would like to renew your account, please go back and select "Renew Account"
" body = body & "Password: " & Password & "
<% Else strUser = Username strMajor = Major strHome = "\\tera\students\" & strMajor & "\" Call CreateUserAccount(sOUDomainPath, cName, sUsername) Call HomeDir() DateTime = NOW Rqst = requesttype 'UserName = Request.querystring("UserName") 'LastName = Request.querystring("LastName") MidName = fmname FirstName = PCase(fName) 'RedID = Request.querystring("RedID") 'Major = Request.querystring("Major") 'Email = Request.querystring("Email") set AccountRequestDB = CreateObject("ADODB.Connection") set accountRS = Createobject("ADODB.Recordset") AccountRequestDB.ConnectionTimeout = 5 AccountRequestDB.CommandTimeout = 10 AccountRequestDB.open "DSN=StudentAccountRequests" accountRS.ActiveConnection = AccountRequestDB theSQL = "insert into acct_requests " theSQL = theSQL & "( Rqst, UserName, Pass, FirstName, MiddleName, LastName, RedID, " theSQL = theSQL & "Major, Email )" theSQL = theSQL & " values ( '"&Rqst&"', '"&UserName&"', '"&Password&"', '"&FirstName&"', '"&MidName&"', '"&LastName&"', '" theSQL = theSQL & RedID&"', '"&Major&"', '"&Email&"' )" AccountRequestDB.Execute(theSQL) AccountRequestDB.close set AccountRequestDB = Nothing set theSQL = nothing call sendmail() %> <%=body%> <% End If else If CheckAD_OU (RedID,Major) = True Then 'WScript.Echo "Returned User Account Found" strUser = Username strMajor = Major strHome = "\\tera\students\" & strMajor & "\" Call RenewResetUserAccount() Call calcs() DateTime = NOW Rqst = requesttype 'UserName = Request.querystring("UserName") 'LastName = Request.querystring("LastName") MidName = PCase(fmname) FirstName = PCase(fName) 'RedID = Request.querystring("RedID") 'Major = Request.querystring("Major") 'Email = Request.querystring("Email") set AccountRequestDB = CreateObject("ADODB.Connection") set accountRS = Createobject("ADODB.Recordset") AccountRequestDB.ConnectionTimeout = 5 AccountRequestDB.CommandTimeout = 10 AccountRequestDB.open "DSN=StudentAccountRequests" accountRS.ActiveConnection = AccountRequestDB theSQL = "insert into acct_requests " theSQL = theSQL & "( Rqst, UserName, Pass, FirstName, MiddleName, LastName, RedID, " theSQL = theSQL & "Major, Email )" theSQL = theSQL & " values ( '"&Rqst&"', '"&UserName&"', '"&Password&"', '"&FirstName&"', '"&MidName&"', '"&LastName&"', '" theSQL = theSQL & RedID&"', '"&Major&"', '"&Email&"' )" AccountRequestDB.Execute(theSQL) AccountRequestDB.close set AccountRequestDB = Nothing set theSQL = nothing call sendmail() %> <%=body%> <% Else %> You do not have an account yet. If you would like to create and account, please go back and select "Create Account"
<% End If End If %>
Public coursename As String
Public coursesemester As String
Public iNameCount As Integer
Public names As Variant
Public description As Variant
Public Function get_names() As String() 'this function loops through the original data and provides a
'2D array of the names of the course outcomes
Sheets("RawData").Activate 'necessary
ActiveCell.Offset(0, 1).Select
Dim names(1 To 50, 0 To 10) As String
Dim description(1 To 50) As String
'Dim iNameCount As Integer
iNameCount = 0
i = 2 'initial point
j = 2
Do Until IsEmpty(Sheets("RawData").Cells(i, j)) 'looping through to get data
Sheets("RawData").Cells(i, j).Select
If IsEmpty(ActiveCell) Then
MsgBox "Exiting Do"
Exit Do
Else
title = Cells(i, j).Value 'just getting name again
position1 = InStr(title, "(")
position2 = InStr(title, ")")
Length = position2 - position1 - 1
test = Mid(title, position1 + 1, Length)
iNameCount = iNameCount + 1 'counter for positions in array
names(iNameCount, 0) = test 'this time we are going to store it in an array
description(iNameCount) = title
'MsgBox description(iNameCount)
j = j + 3
k = k + 1
End If
Loop
For i = 1 To iNameCount 'this will be used later for the frequency calculation
names(i, 1) = 0
names(i, 2) = 0
names(i, 3) = 0
names(i, 4) = 0
names(i, 5) = 0
Next i
get_names = names 'the way VBA returns the array
End Function
Public Function get_description() As String() 'This function generates another array with the whole course names in them.
'This is necessary to pass an array to and fro.
Sheets("RawData").Activate 'necessary
ActiveCell.Offset(0, 1).Select
'Dim names(1 To 50, 0 To 10) As String
Dim description(1 To 50) As String
'Dim iNameCount As Integer
iNameCount = 0
i = 2 'initial point
j = 2
Do Until IsEmpty(Sheets("RawData").Cells(i, j)) 'looping through to get data
Sheets("RawData").Cells(i, j).Select
If IsEmpty(ActiveCell) Then
MsgBox "Exiting Do"
Exit Do
Else
title = Cells(i, j).Value 'just getting name again
title = Replace(title, "(", "")
title = Replace(title, ")", ":")
iNameCount = iNameCount + 1 'counter for positions in array
description(iNameCount) = title
'MsgBox description(iNameCount)
j = j + 3
k = k + 1
End If
Loop
get_description = description 'the way VBA returns the array
End Function
Public Sub create_spreadsheet(name As String) 'nice little function to create the spreadsheets
Dim WS As Worksheet
Set WS = Sheets.Add
WS.name = name
Sheets(name).Cells(1, 1).Value = coursename
Sheets(name).Cells(2, 1).Value = coursesemester
Set WS = Nothing
End Sub
Public Sub border(name As String, row As Integer, column As Integer, n As Integer) 'function to create a border
'around a entire frequency table
here1 = Sheets(name).Cells(row, column).Address
here2 = Sheets(name).Cells(row + n, column + iNameCount).Address
Sheets(name).Activate
Range(here1 & ":" & here2).Select
Selection.borders(xlDiagonalDown).LineStyle = xlNone
Selection.borders(xlDiagonalUp).LineStyle = xlNone
With Selection.borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
Public Sub response_key(name As String, row As Integer, column As Integer) 'this generates the response key
Sheets(name).Activate
Sheets(name).Cells(row, column).Value = "Response Key:"
Sheets(name).Cells(row, column).Font.Bold = True
Sheets(name).Cells(row + 1, column).Value = "1:Strongly Agree"
Sheets(name).Cells(row + 2, column).Value = "2:Agree"
Sheets(name).Cells(row + 3, column).Value = "3:Neither Agree Nor Disagree"
Sheets(name).Cells(row + 4, column).Value = "4: Disagree"
Sheets(name).Cells(row + 5, column).Value = "5:Strongly Disagree"
here1 = Sheets(name).Cells(row, column).Address
here2 = Sheets(name).Cells(row + 5, column + 3).Address
Range(here1 & ":" & here2).Select
Selection.borders(xlDiagonalDown).LineStyle = xlNone
Selection.borders(xlDiagonalUp).LineStyle = xlNone
With Selection.borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
Selection.borders(xlInsideVertical).LineStyle = xlNone
Selection.borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
Private Sub thick_bottom_border(name As String, row As Integer, column As Integer) 'function name says it all
With Sheets(name).Cells(row, column).borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets(name).Cells(row, column + 1).borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
End Sub
Private Sub thin_bottom_border(name As String, row As Integer, column As Integer)
With Sheets(name).Cells(row, column).borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Sheets(name).Cells(row, column + 1).borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
Public Function Originalnames(name As Variant) As String ' this function goes through and matches the
'descriptions to the outcome names
For i = 1 To iNameCount
'MsgBox description(i)
position2 = InStr(description(i), ":") 'position of the : in the string
'MsgBox position2
Value = Mid(description(i), 1, position2 - 1) ' cutting out the name of the outcome
If Value = name Then
'MsgBox "Positive match Scotty!"
Originalnames = description(i) 'returns the function name
Exit For
End If
Next i
End Function
Public Sub Charts_Click() 'LOOK AT THIS LAST.
'this function just takes all the created charts and compiles them in one book.
icounter = 0 'required to make the code only go two graphs across
w = 3 'starting points, w,k
k = 1
For i = 1 To iNameCount
icounter = icounter + 1 'how many have we gone through
Sheets(names(i, 0)).Activate 'necessary as we need to copy the chart
ActiveSheet.ChartObjects("Chart 2").Activate 'activating the chart to copy it
ActiveChart.ChartArea.Copy 'I wonder what that .Copy does
Sheets("All_Charts").Select 'now we have the chart, moving to the right spreadsheet
ActiveSheet.Cells(w, k).Select 'this represents the upper-left corner of the graph
ActiveSheet.Paste 'pasting it in
ActiveSheet.ChartObjects("Chart " & i).Activate 'the i is the chart number, linear as we paste them
ActiveSheet.Shapes("Chart " & i).ScaleWidth 0.7625, msoFalse, msoScaleFromTopLeft 'scaling it down
ActiveSheet.Shapes("Chart " & i).ScaleHeight 0.6840277778, msoFalse, msoScaleFromTopLeft 'scaling it down
If icounter < 2 Then 'if statement to make it put only two charts next to eachother
k = k + 6 'essentially this happens once
Else
k = 1
w = w + 12
icounter = 0
End If
Next i
If counter = 0 Then
w = w - 12 'fixes a problem with the position of the stuff below
End If
For i = 1 To iNameCount
Sheets("All_Charts").Cells(w + 12 + i, 1).Value = Originalnames(names(i, 0))
Next i
Call response_key("All_Charts", w + 15 + iNameCount, 1)
End Sub
Public Sub CommandButton1_Click()
'gets course name and semester for archiving purposes
coursename = InputBox(Prompt:="What is the name of this course?", title:="ENTER COURSE NAME", Default:="ME 101")
coursesemester = InputBox(Prompt:="What is the semester of this course?", title:="ENTER COURSE SEMESTER", Default:="Spring 2011")
' below converts text to numerical equivalents
ActiveSheet.name = "RawData" 'Renames Data sheet so that we can reference it later.
Cells.Replace What:="Strongly Agree", Replacement:="1", LookAt:=xlWhole, MatchCase:=False
Cells.Replace What:="Agree", Replacement:="2", LookAt:=xlWhole, MatchCase:=False
Cells.Replace What:="Neither Agree nor Disagree", Replacement:="3", LookAt:=xlWhole, MatchCase:=False
Cells.Replace What:="Disagree", Replacement:="4", LookAt:=xlWhole, MatchCase:=False
Cells.Replace What:="Strongly Disagree", Replacement:="5", LookAt:=xlWhole, MatchCase:=False
'adds some work sheets we will need later for data storage
Call create_spreadsheet("FormattedData")
Call create_spreadsheet("Frequency")
Call create_spreadsheet("All_Charts")
names = get_names
description = get_description
End Sub
Public Sub CommandButton2_Click() 'this routine extracts the rawdata into the formatted data spreadsheet
'immediately below is probably not necessary. But it activates the right sheet.
Sheets("FormattedData").Activate
ActiveCell.Offset(0, 1).Select
Sheets("RawData").Activate
ActiveCell.Offset(0, 1).Select
Dim i As Integer
Dim j As Integer
Dim w As Integer
Dim k As Integer
Dim Fir As Integer
Dim Fic As Integer
Dim n As Integer
'i,j are for the RawData sheet cells. w,k are for FormattedData Cells
'row,column
i = 2
j = 2
w = 3
k = 3
Sheets("RawData").Cells(i, j).Select
For Position = 1 To iNameCount
'Sheets("RawData").Activate
Sheets("RawData").Cells(i, j).Select 'selecting the cell in the loop
test = names(Position, 0)
Sheets("FormattedData").Cells(w, k).Value = "Response to " & test 'again, just formatting stuff
Sheets("FormattedData").Cells(w, k).Font.Bold = True
'Sheets("formattedData").Cells(w, k).Select
'Call border("FormattedData", w, k)
'The following is for the inner loop, that transfers the data between the two sheets
Rir = i 'R = raw data, I = inner (as in loop), r = row, c = column
Ric = j + 1
Fir = w + 1 'F = Formatted data, I = inner (as in loop), r = row, c = column
Fic = k
n = 0 ' initializing counter to get average, number of entries
flag = 0 'in case we have an occurance
Total = 0 'initializing counter to get counter for average
Do Until IsEmpty(Sheets("RawData").Cells(Rir, Ric)) 'Loop to transfer data
n = n + 1 'Counter, for number of students
If IsEmpty(ActiveCell) Then
Exit Do
Else
If Sheets("RawData").Cells(Rir, Ric).Value <> "" Then
' has no bearance on the results
Select Case Sheets("RawData").Cells(Rir, Ric) 'counting the numbers.
Case 1
names(Position, 1) = names(Position, 1) + 1
Case 2
names(Position, 2) = names(Position, 2) + 1
Case 3
names(Position, 3) = names(Position, 3) + 1
Case 4
names(Position, 4) = names(Position, 4) + 1
Case 5
names(Position, 5) = names(Position, 5) + 1
End Select
Sheets("FormattedData").Cells(Fir, Fic).Value = Sheets("RawData").Cells(Rir, Ric).Value 'moving data
'Call border("FormattedData", Fir, Fic)
Total = Total + Sheets("FormattedData").Cells(Fir, Fic).Value 'running total to calc average
Else
flag = flag + 1 'this is to fix for avg error in the event was encountered
End If
Sheets("FormattedData").Cells(Fir, 2).Value = n 'formatting, counting students
'Call border("FormattedData", Fir, 2)
Rir = Rir + 1
Fir = Fir + 1
End If
Loop
flag = n - flag 'corrects for an cell
avg = Total / flag ' calcing average
'Putting in average, plus 4 is to get below the bottom of data
Sheets("FormattedData").Cells(n + 4, Fic).Value = avg
Sheets("FormattedData").Cells(n + 4, Fic).Font.Bold = True
j = j + 3 'every significant column in RawData is 3 over
k = k + 1 'moving down.
Next Position
Sheets("FormattedData").Cells(n + 4, 2).Value = "Average:" 'Makes it pretty. One might say formatted
Sheets("FormattedData").Cells(n + 4, 2).Font.Bold = True
Sheets("FormattedData").Cells(3, 2).Value = "Student #"
Call border("FormattedData", 3, 2, n)
Sheets("FormattedData").Cells(3, 2).Font.Bold = True
For i = 1 To iNameCount
Sheets("FormattedData").Cells(n + 6, 2).Value = Originalnames(names(i, 0))
n = n + 1
Next i
Call response_key("FormattedData", n + 7, 2)
End Sub
Public Sub CommandButton3_Click() ' this generates the frequency spreadsheet, as well as graphs associated with freq
Sheets("RawData").Activate 'again, might not be necessary
ActiveCell.Offset(0, 1).Select
Dim i As Integer
Dim j As Integer
Dim title
Dim MyColumn As String, Here As String
Dim test As String
Dim w As Integer, k As Integer
'initializing the start point for the data
i = 2
j = 2
w = 3
k = 1
Count = 0
Sheets("RawData").Cells(i, j).Select 'selecting the first cell to start the moving.
For Position = 1 To iNameCount 'this will loop through our array of names to get the data
Count = Count + 1
Sheets("RawData").Activate
Sheets("RawData").Cells(i, j).Select
test = names(Position, 0)
'MsgBox test
Call create_spreadsheet(test)
Sheets("RawData").Activate 'this is required, else a error occurs.
Sheets("Frequency").Cells(w, k).Value = coursename & " " & test
Call thick_bottom_border("Frequency", w, k)
Sheets("Frequency").Cells(w, k).Font.Bold = True
Sheets("Frequency").Cells(w + 1, k).Value = "Response"
Call thin_bottom_border("Frequency", w + 1, k)
Sheets("Frequency").Cells(w + 1, k + 1).Value = "Frequency"
Sheets("Frequency").Cells(w + 1, k).Font.Italic = True
Sheets("Frequency").Cells(w + 1, k + 1).Font.Italic = True
n = 1
'generating the numbers to make the 1 - 5 on the left for frequency bin
For t = 2 To 6
Sheets("Frequency").Cells(w + t, k).Value = n
n = n + 1
Next t
Sheets("frequency").Cells(w + 7, k).Value = "More"
Call thick_bottom_border("Frequency", w + 7, k)
'places values in the proper area
Sheets("Frequency").Cells(w + 2, k + 1).Value = names(Position, 1)
Here = Sheets("Frequency").Cells(w + 2, k + 1).Address
Sheets("Frequency").Cells(w + 3, k + 1).Value = names(Position, 2)
Sheets("Frequency").Cells(w + 4, k + 1).Value = names(Position, 3)
Sheets("Frequency").Cells(w + 5, k + 1).Value = names(Position, 4)
Sheets("Frequency").Cells(w + 6, k + 1).Value = names(Position, 5)
loc1 = w + 2 'this is for the generation of graphs
loc2 = w + 6
'j = j + 3
If Count <> 4 Then 'this just limits how far horizontally it goes in the frequency part.
k = k + 3
Else
k = 1
w = w + 10
Count = 0
End If
' Get the address of the active cell in the current selection
'Here = Sheets("Frequency").Cells(w + 6, k + 1).Address done above
' Because .Address is $$, drop the first
' character and the characters after the column letter(s). WE NEED THIS TO GENERATE THE GRAPH
MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
'The rest will create the histogram.
'the activates are NECESSARY because otherwise the chart-creation commands bark at you
Sheets(test).Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).name = "=""Frequency"""
'converts the frequency data to an excel-based location for the graph:
ActiveChart.SeriesCollection(1).Values = "=Frequency!$" + MyColumn + "$" + CStr(loc1) + &_
":$" + MyColumn + "$" + CStr(loc2)
Sheets(test).Activate
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Select
chartname = coursename & " " & test
ActiveChart.ChartTitle.Text = chartname 'chart title: PO#1 etc
ActiveChart.Location Where:=xlLocationAsObject, name:=test 'giving the chart a title
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis) 'adds a horizontal axis
Selection.Format.TextFrame2.TextRange.Characters.Text = "Response" 'name of axis
ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated) 'adds a vertical axis
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Frequency" 'name of axis
ActiveChart.SeriesCollection(2).Delete 'Slight data error in collecting numbers
ActiveChart.Parent.Cut
Range("A1").Select
ActiveSheet.Paste
Sheets(test).Cells(16, 1).Value = Originalnames(test)
Call response_key(test, 18, 1)
Next Position
End Sub
Private Sub CommandButton4_Click() 'this is the easy button, runs all the buttons above for ease of use
now1 = Timer
CommandButton1_Click
CommandButton2_Click
CommandButton3_Click
Charts_Click
now2 = Timer
timed = now2 - now1
MsgBox "That was easy. It took " & timed & " seconds to execute"
End Sub
Please email me for any relevant coursework examples.
