Microsoft KB Archive/161902

= XL97: Macro Created in Form by Web Form Wizard =

Article ID: 161902

Article Last Modified on 11/23/2006

-

APPLIES TO


 * Microsoft Excel 97 Standard Edition

-



This article was previously published under Q161902



SUMMARY
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.



MORE INFORMATION
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 a Microsoft Certified Partner or the Microsoft fee-based consulting line at (800) 936-5200. For more information about Microsoft Certified Partners, please visit the following Microsoft Web site:

https://partner.microsoft.com/global/30000104

For more information about the support options that are available and about how to contact Microsoft, visit the following Microsoft Web site:

http://support.microsoft.com/default.aspx?scid=fh;EN-US;CNTACTMS

If you create a form using the Web Form Wizard, the following macros are added to a module that is included with the form.

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

StringTooLong: 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

SheetDamaged: 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

BadURLOrSheetDamaged: 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

Function URLEncodeString(ByVal Sin As String) As String 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,, , 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 End Function

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 End Function 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.

