ID: Q161902
The information in this article applies to:
When you use the Microsoft Excel 97 Web Form Wizard to create a form for gathering data over the Internet or an intranet, and you select the "Microsoft Internet Information Server with the Internet Database Connector" option in Step 3 of the Wizard, a Visual Basic for Applications module, called WebForm_Submit, is added to the workbook form created by the Wizard. This article provides the macro code created by the Wizard, and some information on the Auto_Open macro in the module that can be edited.
Microsoft provides programming examples for illustration only, without warranty either expressed or implied, including, but not limited to, the implied warranties of merchantability and/or fitness for a particular purpose. This article assumes that you are familiar with the programming language being demonstrated and the tools used to create and debug procedures. Microsoft support professionals can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific needs. If you have limited programming experience, you may want to contact the Microsoft fee-based consulting line at (800) 936-5200. For more information about the support options available from Microsoft, please see the following page on the World Wide Web:
http://www.microsoft.com/support/supportnet/refguide/
NOTE: Some lines of code have been modified with line continuation characters (_) to fit this document.
Attribute VB_Name = "WebForm_Submit"
Option Explicit
' If you remove the comment markers from the following code, only the
' cells that you specified as input cells in the Web Form Wizard will be
' selectable when the user opens the form. This protects the form from
' users attempting to delete or change objects or cells on the form.
' See the help topic on EnableSelection for additional information.
'Sub Auto_Open()
'
' With ThisWorkbook.ActiveSheet
' .EnableSelection = xlUnlockedCells
' .Protect DrawingObjects:=True, Contents:=True, _
' UserInterfaceOnly:=True
' End With
'End Sub
Sub SubmitInfo()
Dim aControl As Variant
Dim MyArray()
Dim i, j, UBoundaControl, UBoundTestaControl As Integer
Dim sInfoToSubmit, sURL As String
Dim sThisField As String
Dim fDoneFirst As Boolean
Dim iListIndex As Integer
Dim Wks As Worksheet
' Check if there is some hidden name if not quit it
On Error Resume Next
Set Wks = ThisWorkbook.ActiveSheet
sURL = Evaluate(Wks.Names("WebForm_URLOfIDC").Value)
On Error GoTo 0
If IsEmpty(sURL) Then GoTo SheetDamaged
On Error GoTo SheetDamaged
aControl = Evaluate(Wks.Name & "!WebForm_Control")
On Error Resume Next
UBoundTestaControl = UBound(aControl, 2)
On Error GoTo 0
If UBoundTestaControl = 0 Then
UBoundaControl = 1
Else
UBoundaControl = UBound(aControl, 1)
End If
On Error GoTo SheetDamaged
ReDim MyArray(UBoundaControl, 3)
For j = LBound(aControl, 1) To UBoundaControl
If UBoundTestaControl = 0 Then
MyArray(j, 1) = aControl(1)
MyArray(j, 2) = aControl(2)
Else
MyArray(j, 1) = aControl(j, 1)
MyArray(j, 2) = aControl(j, 2)
End If
Select Case TypeName(Evaluate(MyArray(j, 1)))
Case "Range"
MyArray(j, 3) = Wks.Range(MyArray(j, 1)).Value
If Len(MyArray(j, 3)) > 249 Then GoTo StringTooLong
Case "ListBox"
iListIndex = Wks.DrawingObjects(MyArray(j, 1)).ListIndex
If iListIndex <> 0 Then
MyArray(j, 3) = Wks.DrawingObjects(MyArray(j, 1)) _
.List(Wks.DrawingObjects(MyArray(j, 1)).ListIndex)
Else
MyArray(j, 3) = ""
End If
Case "DropDown"
iListIndex = Wks.DrawingObjects(MyArray(j, 1)).ListIndex
If iListIndex <> 0 Then
MyArray(j, 3) = Wks.DrawingObjects(MyArray(j, 1)) _
.List(Wks.DrawingObjects(MyArray(j, 1)).ListIndex)
Else
MyArray(j, 3) = ""
End If
Case "CheckBox"
If Wks.DrawingObjects(MyArray(j, 1)).Value = 1 Then
MyArray(j, 3) = "on"
Else
MyArray(j, 3) = "off"
End If
Case "OptionButton"
If Wks.DrawingObjects(MyArray(j, 1)).Value = 1 _
Then MyArray(j, 3) = MyArray(j, 1)
Case Else
MyArray(j, 3) = Wks.DrawingObjects(MyArray(j, 1)).Value
End Select
Next j
fDoneFirst = False
sInfoToSubmit = ""
For j = LBound(aControl, 1) To UBoundaControl
If Len(CStr(MyArray(j, 3))) > 0 Then
sThisField = URLEncodeString(CStr(MyArray(j, 2))) & -_
"=" & URLEncodeString(CStr(MyArray(j, 3)))
If fDoneFirst Then
sInfoToSubmit = sInfoToSubmit & "&" & sThisField
Else
sInfoToSubmit = sThisField
fDoneFirst = True
End If
End If
Next j
sInfoToSubmit = sURL & "?" & sInfoToSubmit
On Error GoTo BadURLOrSheetDamaged
With ThisWorkbook
.Saved = True
.FollowHyperlink Address:=sInfoToSubmit
End With
On Error GoTo 0
Exit Sub
MsgBox "One or more responses are too long. To continue, shorten any" _
& " response than is more than 249 characters. No information has" _
& " been submitted."
Exit Sub
MsgBox "This form has been modified or damaged. No information has " _
& "been submitted. Please report this problem to the administrator" _
& " of the form."
Exit Sub
MsgBox "No information has been submitted. The reason might be one" _
& " of the following:" & Chr(13) & "* One or more files used in" _
& " this process seems to have been damaged." & Chr(13) & "* The" _
& " URL address which is saved in a defined name in this worksheet" _
& " might be wrong." & Chr(13) & Chr(13) & "Please contact the" _
& " administrator of this file."
Exit Sub
End Sub
Dim sOut As String
Dim iLen As Integer
Dim i As Integer
Dim c As Integer
iLen = Len(Sin)
For i = 1 To iLen
c = Asc(Mid(Sin, i, 1))
Select Case c
' a to z, A to Z, 0 to 9, <period>, <underscore>, <minus>
Case 97 To 122, 65 To 90, 48 To 57, 46, 95, 45
sOut = sOut & Chr(c)
Case 32 ' space
sOut = sOut & "+"
Case Else
sOut = sOut & MakeHexSubstitution(c)
End Select
Next
URLEncodeString = sOut
Function MakeHexSubstitution(c As Integer) As String
Dim sResult As String
sResult = Hex(c)
If Len(sResult) < 2 Then
sResult = "0" & sResult
End If
MakeHexSubstitution = "%" & sResult
NOTE: The Auto_Open sub procedure that is commented-out, by default, can be uncommented to change the protection of your form. If you uncomment this procedure and then save and close the workbook, the next time you open the workbook (either manually or through your browser) you will only be able to select the cells you specified for data input when the form was created with the Web Form Wizard. This is because the cells for data input are not locked and the macro turns on worksheet protection with the EnableSelection property for the worksheet set to xlUnlockedCells.
For more information about the Web Form Wizard, click the Index tab in Microsoft Excel Help, type the following text
web form wizard
For more information about the EnableSelection Property, click the Office Assistant in the Visual Basic Editor, type "enableselection", click Search, and then click to view "EnableSelection Property".
Additional query words: 97 XL97
Keywords : kbprg kbtool kbdta kbdtacode xlwiz KbVBA xlweb
Version : WINDOWS:97
Platform : WINDOWSLast Reviewed: May 18, 1999