Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

HELP! What did I do?

Status
Not open for further replies.

RClarkeJr

Programmer
Nov 10, 2004
20
US
When I run this vbscript on a webpage, it sends an email with the information gathered on the webpage. In the process, it renames the Inbox in Outlook. How did I do that?

Please help!

Code:
Dim ConstSubject
Dim ConstComment
Dim ConstCount
Dim ConstRecpCount
Dim WSHShell
Dim FileNames
Dim ConstFile1
Dim ConstFile2
Dim ConstFile3
Dim ConstFile4
Dim ConstFile5
Dim ConstRep1
Dim ConstRep2
Dim ConstRep3
Dim ConstRep4
Dim ConstRep5
	
Sub cmdCreate_OnClick	
	Dim ToText
	Dim Name
	Dim Fax
	Dim myOlApp
	Dim myItem 	
	CheckFileList
	If 	ConstCount = 0 then
		Exit Sub
	End If
	RecipList
	If ConstRecpCount = 0 then
		Exit Sub
	End If
	ConstComment = document.FORM1.txtComment.value
	Set WSHShell = CreateObject("WScript.Shell")			
	Set myOlApp = CreateObject("Outlook.Application")
	Set myItem = myOlApp.CreateItem(olMailItem)				
	myOlApp.ActiveWindow = 0 			
	myItem.display 
	If ConstRecpCount = 1 Then
		myItem.To = ConstRep1
	End If
	If ConstRecpCount = 2 Then
		myItem.To = ConstRep1
		myItem.CC = ConstRep2
	End If
	If ConstRecpCount = 3 Then
		myItem.To = ConstRep1
		myItem.CC = ConstRep2 & chr(59) & ConstRep3
	End If
	If ConstRecpCount = 4 Then
		myItem.To = ConstRep1
		myItem.CC = ConstRep2 & chr(59) & ConstRep3 & chr(59) & ConstRep4
	End If
	If ConstRecpCount = 5 Then
		myItem.To = ConstRep1
		myItem.CC = ConstRep2 & chr(59) & ConstRep3 & chr(59) & ConstRep4 & chr(59) & ConstRep5
	End If				
	myItem.Subject= ConstSubject
	myItem.Body = chr(13) & chr(13) & ConstComment
	myItem.Save
	Set myAttachments = myItem.Attachments
	If ConstCount = 1 Then
		myAttachments.Add ConstFile1
	End If
	If ConstCount = 2 Then
		myAttachments.Add ConstFile1
		myAttachments.Add ConstFile2
	End If
	If ConstCount = 3 Then
		myAttachments.Add ConstFile1
		myAttachments.Add ConstFile2
		myAttachments.Add ConstFile3
	End If
	If ConstCount = 4 Then
		myAttachments.Add ConstFile1
		myAttachments.Add ConstFile2
		myAttachments.Add ConstFile3
		myAttachments.Add ConstFile4
	End If
	If ConstCount = 5 Then
		myAttachments.Add ConstFile1
		myAttachments.Add ConstFile2
		myAttachments.Add ConstFile3
		myAttachments.Add ConstFile4
		myAttachments.Add ConstFile5			
	End If
	WSHShell.AppActivate myItem
	WSHShell.SendKeys ("%(s)")
	ClearForm		
End Sub


Sub RecipList
	Dim TempName
	Dim TempFax
	Dim LenCount
	ConstRecpCount = document.FORM1.lstRecipients.length
	If ConstRecpCount = 0 Then
		MsgBox "Please include a recipient"
		Exit Sub
	End If
	If ConstRecpCount = 1 Then
		Rep1
	End If
	If ConstRecpCount = 2 Then
		Rep1
		Rep2
	End If
	If ConstRecpCount = 3 Then
		Rep1
		Rep2
		Rep3
	End If
	If ConstRecpCount = 4 Then
		Rep1
		Rep2
		Rep3
		Rep4
		Rep5
	End If
	If ConstRecpCount = 5 Then
		Rep1
		Rep2
		Rep3
		Rep4
		Rep5
	End If	
End Sub

Sub Rep1
	Dim TempName
	Dim TempFax
	Dim LenCount
	LenCount = Len(document.FORM1.lstRecipients.firstChild.innertext)
	TempName = Left (document.FORM1.lstRecipients.firstChild.innertext, LenCount-13)
	TempFax = document.FORM1.lstRecipients.firstChild.value		
	ConstRep1 = "/Name=" & TempName & "/fax=" & TempFax & "/<fax@faxit.travp.net>"
End Sub

Sub Rep2
	Dim TempName
	Dim TempFax
	Dim LenCount
	LenCount = Len(document.FORM1.lstRecipients.firstChild.nextSibling.innertext)
	TempName = Left (document.FORM1.lstRecipients.firstChild.nextSibling.innertext, LenCount-13)
	TempFax = document.FORM1.lstRecipients.firstChild.nextSibling.value		
	ConstRep2 = "/Name=" & TempName & "/fax=" & TempFax & "/<fax@faxit.travp.net>"
End Sub

Sub Rep3
	Dim TempName
	Dim TempFax
	Dim LenCount
	LenCount = Len(document.FORM1.lstRecipients.firstChild.nextSibling.nextSibling.innertext)
	TempName = Left (document.FORM1.lstRecipients.firstChild.nextSibling.nextSibling.innertext, LenCount-13)
	TempFax = document.FORM1.lstRecipients.firstChild.nextSibling.nextSibling.value		
	ConstRep3 = "/Name=" & TempName & "/fax=" & TempFax & "/<fax@faxit.travp.net>"
End Sub

Sub Rep4
	Dim TempName
	Dim TempFax
	Dim LenCount
	LenCount = Len(document.FORM1.lstRecipients.firstChild.nextSibling.nextSibling.nextSibling.innertext)
	TempName = Left (document.FORM1.lstRecipients.firstChild.nextSibling.nextSibling.nextSibling.innertext, LenCount-13)
	TempFax = document.FORM1.lstRecipients.firstChild.nextSibling.nextSibling.nextSibling.value		
	ConstRep4 = "/Name=" & TempName & "/fax=" & TempFax & "/<fax@faxit.travp.net>"
End Sub

Sub Rep5
	Dim TempName
	Dim TempFax
	Dim LenCount
	LenCount = Len(document.FORM1.lstRecipients.firstChild.nextSibling.nextSibling.nextSibling.nextSibling.innertext)
	TempName = Left (document.FORM1.lstRecipients.firstChild.nextSibling.nextSibling.nextSibling.nextSibling.innertext, LenCount-13)
	TempFax = document.FORM1.lstRecipients.firstChild.nextSibling.nextSibling.nextSibling.nextSibling.value		
	ConstRep5 = "/Name=" & TempName & "/fax=" & TempFax & "/<fax@faxit.travp.net>"
End Sub

Sub CheckFileList
	ConstCount = document.FORM1.lstFile.length
	If 	ConstCount = 0 then
		MsgBox "Please attach a file"
		Exit Sub
	End If
	If 	ConstCount = 1 then
		ConstFile1 = document.FORM1.lstFile.firstChild.innertext
	End If
	If ConstCount = 2 Then
		ConstFile1 = document.FORM1.lstFile.firstChild.innertext
		ConstFile2 = document.FORM1.lstFile.firstChild.nextSibling.innertext
	End If
	If ConstCount = 3 Then
		ConstFile1 = document.FORM1.lstFile.firstChild.innertext
		ConstFile2 = document.FORM1.lstFile.firstChild.nextSibling.innertext	
		ConstFile3 = document.FORM1.lstFile.firstChild.nextSibling.nextSibling.innertext
	End If
	If ConstCount = 4 Then
		ConstFile1 = document.FORM1.lstFile.firstChild.innertext
		ConstFile2 = document.FORM1.lstFile.firstChild.nextSibling.innertext	
		ConstFile3 = document.FORM1.lstFile.firstChild.nextSibling.nextSibling.innertext
		ConstFile4 = document.FORM1.lstFile.firstChild.nextSibling.nextSibling.nextSibling.innertext
	End If
	If ConstCount = 5 Then
		ConstFile1 = document.FORM1.lstFile.firstChild.innertext
		ConstFile2 = document.FORM1.lstFile.firstChild.nextSibling.innertext	
		ConstFile3 = document.FORM1.lstFile.firstChild.nextSibling.nextSibling.innertext
		ConstFile4 = document.FORM1.lstFile.firstChild.nextSibling.nextSibling.nextSibling.innertext
		ConstFile5 = document.FORM1.lstFile.firstChild.nextSibling.nextSibling.nextSibling.nextSibling.innertext	
	End If		
End Sub


Sub cmdAddR_OnClick
	Dim optOption
	Dim lstIndex
	Dim lstCount	
	lstIndex = document.FORM1.lstRecipients.selectedIndex
	Set optOption = document.createElement("OPTION")
	lstCount = document.FORM1.lstRecipients.length
	ConstSubject = document.FORM1.txtSubject.value
	If lstCount = 5 then
		MsgBox "You have Exceeded the Maximum of Five (5) Recipients", , "Fax It"
		document.FORM1.txtName.value = empty
		document.FORM1.txtFax.value = empty
		Exit Sub
	Else		
		lstCount = document.FORM1.lstRecipients.length
		optOption.text = document.FORM1.txtName.value & " @ " & document.FORM1.txtFax.value
		optOption.value = document.FORM1.txtFax.value	
		document.FORM1.lstRecipients.add optOption
		ConstSubject = document.FORM1.txtSubject.value
		document.FORM1.txtName.value = empty
		document.FORM1.txtFax.value = empty	
		document.FORM1.txtSubject.value = empty
		lstCount = document.FORM1.lstRecipients.length			
	End If
End Sub

Sub cmdRemoveR_OnClick
	Dim lstIndex
	dim LenCount
	lstIndex = document.FORM1.lstRecipients.selectedIndex
	document.FORM1.txtFax.value = document.FORM1.lstRecipients.value
	LenCount = Len(document.FORM1.lstRecipients.item.text)
	document.FORM1.txtName.value = Left (document.FORM1.lstRecipients.item.text, LenCount-13)	
	document.FORM1.lstRecipients.remove lstIndex
	document.FORM1.txtSubject.value = ConstSubject	
End Sub

Sub cmdCancel_OnClick
	Close
End Sub

Sub cmdAddF_OnClick
	Dim optOption
	Dim lstIndex
	Dim lstCount	
	Set optOption = document.createElement("OPTION")
	lstIndex = document.FORM1.lstForms.selectedIndex	
	If lstCount >= 5 then
		MsgBox "You have Exceeded the Maximum of Five (5) files", , "Fax It"
		Exit Sub
	Else	
		If document.FORM1.txtFile.value = "" then
			lstCount = document.FORM1.lstFile.length				
			optOption.text = document.FORM1.lstForms.value
			optOption.value = document.FORM1.lstForms.value	
			document.FORM1.lstFile.add optOption
			FileNames = optOption.text 		
		Else
			lstCount = document.FORM1.lstFile.length		
			optOption.text = document.FORM1.txtFile.value 
			optOption.value = document.FORM1.txtFile.value
			document.FORM1.lstFile.add optOption
			FileNames = optOption.value					
		End If
	End If			
End Sub

Sub cmdRemoveF_OnClick
	Dim lstIndex
	lstIndex = document.FORM1.lstFile.selectedIndex
	document.FORM1.lstFile.remove lstIndex		
End Sub

Sub reset1_OnClick
	ClearForm
End Sub

Sub ClearForm
	document.FORM1.txtName.form.reset	
	document.FORM1.lstFile.remove 4
	document.FORM1.lstFile.remove 3
	document.FORM1.lstFile.remove 2
	document.FORM1.lstFile.remove 1
	document.FORM1.lstFile.remove 0
	document.FORM1.lstRecipients.remove 4
	document.FORM1.lstRecipients.remove 3
	document.FORM1.lstRecipients.remove 2
	document.FORM1.lstRecipients.remove 1
	document.FORM1.lstRecipients.remove 0
	document.FORM1.txtFile.value = "Empty"
End Sub
 
not sure but the whole

If ConstRecpCount = 1 Then
Rep1
End If
If ConstRecpCount = 2 Then
Rep1
Rep2
End If
If ConstRecpCount = 3 Then
Rep1
Rep2
Rep3
End If
If ConstRecpCount = 4 Then
Rep1
Rep2
Rep3
Rep4
Rep5
End If
If ConstRecpCount = 5 Then
Rep1
Rep2
Rep3
Rep4
Rep5
End If

could be avoided if you built an array of recipiant and an array of attachments. or a dictionary object if you are lazy like me and hate redim'nstuff

if you built an array you could change all those if statement and replace the lot with

For Each aElement In arrRep
aElement 'do something
Next

For Each aElement In arrAttachemts
objMail.AddAttachment aElement
Next
 
you could also get rid of all your rep subs and replace with one function. you could prob tidy up the select case statement but i havent thought about it too hard



Function returnRep(intDepth)
Dim TempName
Dim TempFax
Dim LenCount, i, strTemp
Select Case intDepth
Case 1
LenCount = Len(document.FORM1.lstRecipients.firstChild.index)
TempFax = document.FORM1.lstRecipients.firstChild.value
TempName = Left (document.FORM1.lstRecipients.firstChild.index, LenCount-13)
Case 2
TempFax = document.FORM1.lstRecipients.firstChild.value
Case 3
End Select
LenCount = Len(strTemp)

returnRep = "/Name=" & TempName & "/fax=" & TempFax & "/<fax@faxit.travp.net>"
End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top