Can asp script create subdirectory upon upload?

I'm using freeASPupload script and have had help adding a feature where the email address of the user is added to the file name being uploaded (line 135 below) which is:

streamFile.SaveToFile path & (Session("PMMS_EMAIL")) & "~~" & fileItem.FileName, 2

Code (markup):

and it works successfully.

Can a line of code be added that will automatically create a subdirectory, named: "users email address", upon upload submission? Thanks. I look forward to your reply.

<%
'  For examples, documentation, and your own free copy, go to:
'  http://www.freeaspupload.net
'  Note: You can copy and use this script for free and you can make changes
'  to the code, but you cannot remove the above comment.

'Changes:
'Aug 2, 2005: Add support for checkboxes and other input elements with multiple values

' November 2007 added file size limitations and file extension checking

Class FreeASPUpload
	Public UploadedFiles
	Public FormElements

	Private VarArrayBinRequest
	Private StreamRequest
	Private uploadedYet

'	added by Chris Hirst www.candsdesign.co.uk November 2007
	private m_lMaxFileSize
	private m_sByteMultiplier

	private m_sFileError
	private m_bFileError
' **********************************************
	Private Sub Class_Initialize()
		Set UploadedFiles = Server.CreateObject("Scripting.Dictionary")
		Set FormElements = Server.CreateObject("Scripting.Dictionary")
		Set StreamRequest = Server.CreateObject("ADODB.Stream")
		StreamRequest.Type = 1 'adTypeBinary
		StreamRequest.Open
		uploadedYet = false
'		m_lMaxFileSize = 2048000
	End Sub

	Private Sub Class_Terminate()
		If IsObject(UploadedFiles) Then
			UploadedFiles.RemoveAll()
			Set UploadedFiles = Nothing
		End If
		If IsObject(FormElements) Then
			FormElements.RemoveAll()
			Set FormElements = Nothing
		End If
		StreamRequest.Close
		Set StreamRequest = Nothing
	End Sub

' ***************** new properties and methods
'	added by Chris Hirst www.candsdesign.co.uk  November 2007
	public function  setMaxFileSize(ByVal Val, Mult)
		m_sByteMultiplier = Mult
		select case lcase(m_sByteMultiplier)
			case ""
				m_lMaxFileSize = Val
			case "k"
				m_lMaxFileSize = Val * 1024
			case "m"
				m_lMaxFileSize = Val * (1024 * 1024)
		end select
	end function

	public property get MaxFileSize()
		MaxFileSize = m_lMaxFileSize
	end property

	public property get Error()
		Error = m_bFileError
	end property

	public property get ErrorStatus()
		ErrorStatus = m_sFileError
	end property

	private function CheckExtension(strIn)
	' function to validate numeric input
		dim objRE
		set objRE = New RegExp
		objRE.Pattern = "^.+\.((txt)|(pdf)|(html)|(htm)|(doc)|(rtf))$"
		objRE.Global = True
		CheckExtension = objRE.test(strIn)
		set objRE = nothing
	end function

	public function getMult()
		select case lcase(m_sByteMultiplier)
			case ""
				getMult = "Bytes"
			case "k"
				getMult = "Kilobytes"
			case "m"
				getMult = "Megabytes"
		end select
	end function

' *************** end new property

	Public Property Get Form(sIndex)
		Form = ""
		If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex))
	End Property

	Public Property Get Files()
		Files = UploadedFiles.Items
	End Property

	'Calls Upload to extract the data from the binary request and then saves the uploaded files
	' Save method recoded November 2007 to add checks for files size and extensions

	Public Sub Save(path)
		Dim streamFile, fileItem

		if Right(path, 1) <> "\" then path = path & "\"

		if not uploadedYet then Upload

		For Each fileItem In UploadedFiles.Items
		m_bFileError = false
		if fileItem.Length > m_lMaxFileSize then
			m_sFileError = "Exceeds maximum filesize"
			m_bFileError = true
		end if
		if not CheckExtension(fileItem.FileName)  then
			m_sFileError = "Invalid filetype"
			m_bFileError = true
		end if
		if not m_bFileError then
			Set streamFile = Server.CreateObject("ADODB.Stream")
			streamFile.Type = 1
			streamFile.Open
			StreamRequest.Position=fileItem.Start
			StreamRequest.CopyTo streamFile, fileItem.Length
			streamFile.SaveToFile path & (Session("PMMS_EMAIL")) & "~~" & fileItem.FileName, 2
			streamFile.close
			Set streamFile = Nothing
			fileItem.Path = path & fileItem.FileName
		else
			fileItem.FileName = fileItem.FileName & " Discarded - " & m_sFileError
		end if
		 Next
	End Sub

	Public Function SaveBinRequest(path) ' For debugging purposes
		StreamRequest.SaveToFile path & "\debugStream.bin", 2
	End Function

	Public Sub DumpData() 'only works if files are plain text
		Dim i, aKeys, f
		response.write "Form Items:<br>"
		aKeys = FormElements.Keys
		For i = 0 To FormElements.Count -1 ' Iterate the array
			response.write aKeys(i) & " = " & FormElements.Item(aKeys(i)) & "<BR>"
		Next
		response.write "Uploaded Files:<br>"
		For Each f In UploadedFiles.Items
			response.write "Name: " & f.FileName & "<br>"
			response.write "Type: " & f.ContentType & "<br>"
			response.write "Start: " & f.Start & "<br>"
			response.write "Size: " & f.Length & "<br>"
		 Next
   	End Sub

	Private Sub Upload()
		Dim nCurPos, nDataBoundPos, nLastSepPos
		Dim nPosFile, nPosBound
		Dim sFieldName, osPathSep, auxStr

		'RFC1867 Tokens
		Dim vDataSep
		Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType
		tNewLine = Byte2String(Chr(13))
		tDoubleQuotes = Byte2String(Chr(34))
		tTerm = Byte2String("--")
		tFilename = Byte2String("filename=""")
		tName = Byte2String("name=""")
		tContentDisp = Byte2String("Content-Disposition")
		tContentType = Byte2String("Content-Type:")

		uploadedYet = true

		on error resume next
		VarArrayBinRequest = Request.BinaryRead(Request.TotalBytes)
		if Err.Number <> 0 then
			response.write "<br><br><B>System reported this error:</B><p>"
			response.write Err.Description & "<p>"
			response.write "The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>"
			Exit Sub
		end if
		on error goto 0 'reset error handling

		nCurPos = FindToken(tNewLine,1) 'Note: nCurPos is 1-based (and so is InstrB, MidB, etc)

		If nCurPos <= 1  Then Exit Sub

		'vDataSep is a separator like -----------------------------21763138716045
		vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1)

		'Start of current separator
		nDataBoundPos = 1

		'Beginning of last line
		nLastSepPos = FindToken(vDataSep & tTerm, 1)

		Do Until nDataBoundPos = nLastSepPos

			nCurPos = SkipToken(tContentDisp, nDataBoundPos)
			nCurPos = SkipToken(tName, nCurPos)
			sFieldName = ExtractField(tDoubleQuotes, nCurPos)

			nPosFile = FindToken(tFilename, nCurPos)
			nPosBound = FindToken(vDataSep, nCurPos)

			If nPosFile <> 0 And  nPosFile < nPosBound Then
				Dim oUploadFile
				Set oUploadFile = New UploadedFile

				nCurPos = SkipToken(tFilename, nCurPos)
				auxStr = ExtractField(tDoubleQuotes, nCurPos)
                ' We are interested only in the name of the file, not the whole path
                ' Path separator is \ in windows, / in UNIX
                ' While IE seems to put the whole pathname in the stream, Mozilla seem to
                ' only put the actual file name, so UNIX paths may be rare. But not impossible.
                osPathSep = "\"
                if InStr(auxStr, osPathSep) = 0 then osPathSep = "/"
				oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep))

				if (Len(oUploadFile.FileName) > 0) then 'File field not left empty
					nCurPos = SkipToken(tContentType, nCurPos)

                    auxStr = ExtractField(tNewLine, nCurPos)
                    ' NN on UNIX puts things like this in the streaa:
                    '    ?? python py type=?? python application/x-python
					oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " "))
					nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line

					oUploadFile.Start = nCurPos-1
					oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos

					If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile
				End If
			Else
				Dim nEndOfData
				nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
				nEndOfData = FindToken(vDataSep, nCurPos) - 2
				If Not FormElements.Exists(LCase(sFieldName)) Then
					FormElements.Add LCase(sFieldName), String2Byte(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos))
				else
                    FormElements.Item(LCase(sFieldName))= FormElements.Item(LCase(sFieldName)) & ", " & String2Byte(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos))
                end if

			End If

			'Advance to next separator
			nDataBoundPos = FindToken(vDataSep, nCurPos)
		Loop
		StreamRequest.Write(VarArrayBinRequest)
	End Sub

	Private Function SkipToken(sToken, nStart)
		SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)
		If SkipToken = 0 then
			Response.write "Error in parsing uploaded binary request."
			Response.End
		end if
		SkipToken = SkipToken + LenB(sToken)
	End Function

	Private Function FindToken(sToken, nStart)
		FindToken = InstrB(nStart, VarArrayBinRequest, sToken)
	End Function

	Private Function ExtractField(sToken, nStart)
		Dim nEnd
		nEnd = InstrB(nStart, VarArrayBinRequest, sToken)
		If nEnd = 0 then
			Response.write "Error in parsing uploaded binary request."
			Response.End
		end if
		ExtractField = String2Byte(MidB(VarArrayBinRequest, nStart, nEnd-nStart))
	End Function

	'String to byte string conversion
	Private Function Byte2String(sString)
		Dim i
		For i = 1 to Len(sString)
		   Byte2String = Byte2String & ChrB(AscB(Mid(sString,i,1)))
		Next
	End Function

	'Byte string to string conversion
	Private Function String2Byte(bsString)
		Dim i
		String2Byte =""
		For i = 1 to LenB(bsString)
		   String2Byte = String2Byte & Chr(AscB(MidB(bsString,i,1)))
		Next
	End Function
End Class

Class UploadedFile
	Public ContentType
	Public Start
	Public Length
	Public Path
	Private nameOfFile

    ' Need to remove characters that are valid in UNIX, but not in Windows
    Public Property Let FileName(fN)
        nameOfFile = fN
        nameOfFile = SubstNoReg(nameOfFile, "\", "_")
        nameOfFile = SubstNoReg(nameOfFile, "/", "_")
        nameOfFile = SubstNoReg(nameOfFile, ":", "_")
        nameOfFile = SubstNoReg(nameOfFile, "*", "_")
        nameOfFile = SubstNoReg(nameOfFile, "?", "_")
        nameOfFile = SubstNoReg(nameOfFile, """", "_")
        nameOfFile = SubstNoReg(nameOfFile, "<", "_")
        nameOfFile = SubstNoReg(nameOfFile, ">", "_")
        nameOfFile = SubstNoReg(nameOfFile, "|", "_")
    End Property

    Public Property Get FileName()
        FileName = nameOfFile
    End Property

    'Public Property Get FileN()ame
End Class


' Does not depend on RegEx, which is not available on older VBScript
' Is not recursive, which means it will not run out of stack space
Function SubstNoReg(initialStr, oldStr, newStr)
    Dim currentPos, oldStrPos, skip
    If IsNull(initialStr) Or Len(initialStr) = 0 Then
        SubstNoReg = ""
    ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then
        SubstNoReg = initialStr
    Else
        If IsNull(newStr) Then newStr = ""
        currentPos = 1
        oldStrPos = 0
        SubstNoReg = ""
        skip = Len(oldStr)
        Do While currentPos <= Len(initialStr)
            oldStrPos = InStr(currentPos, initialStr, oldStr)
            If oldStrPos = 0 Then
                SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1)
                currentPos = Len(initialStr) + 1
            Else
                SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr
                currentPos = oldStrPos + skip
            End If
        Loop
    End If
End Function
%>

Code (markup):

 

Function CreateTextFileRead(vFile)
	Dim oStream
	Set oStream = CreateObject("Adodb.Stream")
	With oStream
		.charset = "utf-8"
		.Type = 2
		.Open
		If inStr(vFile, ":")>0 Then
			.LoadFromFile vFile
		Else
			.LoadFromFile Server.MapPath(vFile)
		End If
		CreateTextFileRead = .ReadText
		.Close
	End With
	Set oStream = Nothing
End Function

Function kCreateCheckPath(oFs, vPath)
	kCreateCheckPath = vPath
	Dim vStr
	If Right(vPath, 1) <> "\" Then
		vStr = oFs.GetParentFolderName(vPath)
	Else
		vStr = vPath
	End If
	If Not oFs.FolderExists(vStr) Then
		Dim vLoop, vForder, vForderC
		vLoop = 0
		vForderC = vStr & "\"
		vForder = Left(vStr, 2)
		vForderC = Right(vForderC, Len(vForderC) - Len(vForder))
		On Error Resume Next
		While vLoop<20 And vForderC <> ""
			vLoop = vLoop + 1
			vForder = vForder & Mid(vForderC, 1, Instr(vForderC,"\"))
			vForderC = Mid(vForderC, Instr(vForderC,"\") + 1)
			If Not oFs.FolderExists(vForder) Then oFs.CreateFolder(vForder)
		Wend
		On Error GoTo 0
		If Not oFs.FolderExists(vStr) Then
			Set oFs = Nothing
			Response.Write "<ul><b>Cannot Write Disk</b><li>For Folder: " & vStr & "</li><li>For File: " & vPath & "</li></ul>"
			Response.End
		End If
	End If
End Function

Sub CreateTextFileWrite(vFile, vStr)
	Dim oFs, oStream, vFilename
	If inStr(vFile, ":")= 0 Then
		vFilename = Server.MapPath(vFile)
	Else
		vFilename = vFile
	End If
	Set oFs = CreateObject("Scripting.FileSystemObject")
	If oFs.FileExists(vFilename) Then
		If CreateTextFileRead(vFilename) = vStr Then
			Set oFs = Nothing
			Exit Sub
		End If
	End If
	kCreateCheckPath oFs, vFilename
	Set oFs = Nothing

	Set oStream = CreateObject("Adodb.Stream")
	With oStream
		.charset = "utf-8"
		.Type = 2
		.Open
		.WriteText vStr
		.SaveToFile vFilename, 2
		.Close
	End With
	Set oStream = Nothing
End Sub

Code (markup):

 

I'm not very well versed in ASP, so do you mind if I ask a few questions about your code, please?

Does the code create a folder, upon upload, that is named for the user's email address?

Where is the folder created?

Where in the script should I add this code?

Thanks.