Excel VBA to set fields or radio buttons in Internet Explorer

R

rconverse

Well-known Member
Joined
Nov 29, 2007
Messages
1,187
Hello,

I'm using some code from here: How to automate web forms from VBA using Internet Explorer - VBA Visual Basic for Applications (Microsoft) FAQ - Tek-Tips

So far, I can get the text fields to populate. I can't seem to get the radio buttons to update. In the "Set Fields" column of my spreadsheet, I have tried the value "N" and TRUE but neither seem to work. (Full code below this sub.)

Rich (BB code): 
Sub SetFields()
On Error Resume Next
Dim objIE As Object
Dim objParent As Object
Dim objInputElement As Object
Dim lngRow As Long

Set objIE = GetIEApp 'Make sure an IE object was hooked

If TypeName(objIE) = "Nothing" Then
    MsgBox "Could not hook Internet Explorer object", vbCritical, "GetFields() Error"
    GoTo Clean_Up
End If

For lngRow = 2 To ActiveSheet.UsedRange.Rows.Count
    If ActiveSheet.Cells(lngRow, cElement_SetValue) <> "" Then
    
        'If we have a parent name/ID drill to that element, otherwise point to whole document
        If ActiveSheet.Cells(lngRow, cForm_name).Text <> "" Then
            Set objParent = objIE.Document.forms(ActiveSheet.Cells(lngRow, cForm_name).Text)
        ElseIf ActiveSheet.Cells(lngRow, cForm_Id).Text <> "" Then
            Set objParent = objIE.Document.forms(ActiveSheet.Cells(lngRow, cForm_Id).Text)
        Else: Set objParent = objIE.Document.all
        End If
        

'*****************
'this is the piece where I can't get the radeio buttons to populate

        With objParent
            If ActiveSheet.Cells(lngRow, cElement_Type) = "radio" Then
                Set objInputElement = objParent.tags("INPUT").Item(ActiveSheet.Cells(lngRow, cElement_Name).Text)
                objInputElement.Item(ActiveSheet.Cells(lngRow, cElement_ID).Text).Checked = True
                Set objInputElement = Nothing         
'*****************   
            ElseIf ActiveSheet.Cells(lngRow, cElement_Type) = "checkbox" Then
                objParent.Item(ActiveSheet.Cells(lngRow, cElement_ID).Text).Checked = True
            Else
                objParent.Item(ActiveSheet.Cells(lngRow, cElement_Name).Text).Value = CStr(ActiveSheet.Cells(lngRow, cElement_SetValue))
            End If
        End With
        
        If Err.Number <> 0 Then
        Debug.Print "Error Writting: Row " & lngRow, ActiveSheet.Cells(lngRow, cElement_Name), ActiveSheet.Cells(lngRow, cElement_SetValue)
        Err.Clear
        End If
    End If
Next lngRow
Clean_Up:
Set objParent = Nothing
Set objIE = Nothing
End Sub

Full code:

Rich (BB code): 
Option Explicit
Option Compare Text
Const cForm_name As Long = 1
Const cForm_Id As Long = 2
Const cElement_Name As Long = 3
Const cElement_ID As Long = 4
Const cElement_nodeName As Long = 5
Const cElement_Type As Long = 6
Const cElement_Value As Long = 7
Const cElement_SetValue As Long = 8
Sub GetFields()
On Error GoTo GetFields_Error
Dim objIE As Object
Dim objForms As Object, objForm As Object
Dim objInputElement As Object
Dim objOption As Object
Dim lngRow As Long
Dim strComment As String

Set objIE = GetIEApp 'Make sure an IE object was hooked
If TypeName(objIE) = "Nothing" Then
    MsgBox "Could not hook Internet Explorer object", vbCritical, "GetFields() Error"
    GoTo Clean_Up
End If
'In case the sheet is being resused, clear it ClearActiveSheet
'Get the forms object
Set objForms = objIE.Document.forms 'Test to see if there are forms before proceding
If objForms.Length <> 0 Then
'Write the header
lngRow = lngRow + 1
With ActiveSheet
    .Cells(lngRow, cForm_name) = "Form_Name"
    .Cells(lngRow, cForm_Id) = "Form_ID"
    .Cells(lngRow, cElement_Name) = "Element_Name"
    .Cells(lngRow, cElement_ID) = "Element_ID"
    .Cells(lngRow, cElement_nodeName) = "Element_nodeName"
    .Cells(lngRow, cElement_Type) = "Element_Type"
    .Cells(lngRow, cElement_Value) = "Element_Value"
    .Cells(lngRow, cElement_SetValue) = "Element_SetValue"
End With   'End Header
'Cycle through all the forms in the document
For Each objForm In objForms
    'Cycle through the input elements in the form
    For Each objInputElement In objForm
        lngRow = lngRow + 1
            With ActiveSheet
                .Cells(lngRow, cForm_name) = objForm.Name
                .Cells(lngRow, cForm_Id) = objForm.ID
                .Cells(lngRow, cElement_Name) = objInputElement.Name
                .Cells(lngRow, cElement_ID) = objInputElement.ID
                .Cells(lngRow, cElement_nodeName) = objInputElement.nodeName
                .Cells(lngRow, cElement_Type) = objInputElement.Type
                    If objInputElement.Type = "submit" Or objInputElement.Type = "button" Then
                        .Cells(lngRow, cElement_SetValue).Interior.Color = vbBlack
                    ElseIf objInputElement.Type = "hidden" Then
                        .Cells(lngRow, cElement_SetValue).Interior.Color = vbYellow
                    End If
                .Cells(lngRow, cElement_Value) = objInputElement.Value
                'build a list of the possible selections for a select elements
                If objInputElement.nodeName = "SELECT" Then
                For Each objOption In objInputElement
                    strComment = strComment & Chr(34) & objOption.Value & Chr(34) & ": " & objOption.Text & vbNewLine
                Next objOption
                'place the list as a comment in the SetValue column
                .Cells(lngRow, cElement_SetValue).AddComment strComment
                strComment = ""
                End If
            End With
    Next objInputElement
Next objForm
End If

Clean_Up: Set objInputElement = Nothing
Set objForm = Nothing
Set objForms = Nothing
Set objIE = Nothing
Exit Sub
GetFields_Error: Debug.Print Err.Number, Err.Description
Resume Next

'MsgBox "The process is complete.", vbOKOnly, "PROCESS COMPLETE"

End Sub
Function GetIEApp() As Object
Dim objShell As Object
Dim objWindows As Object
Dim objWindow As Object
Dim lngSingleWindow As Long
Dim intOption As Integer
Dim strMessage As String, strReturnValue As String

Set objShell = CreateObject("Shell.Application")
Set objWindows = objShell.Windows
lngSingleWindow = -1
For Each objWindow In objWindows
'Build a list of windows, make sure they are Internet Explorer
If Right(objWindow.FullName, 12) = "iexplore.exe" Then
    strMessage = strMessage & intOption & " : " & objWindow.LocationName & vbCrLf
    If lngSingleWindow = -1 Then
        lngSingleWindow = intOption
    Else
        lngSingleWindow = 0
    End If
End If
intOption = intOption + 1
Next
'Check if there are any IE windows
If Len(strMessage) <> 0 Then   'Prompt to pick a window, used an InputBox for portability
    If lngSingleWindow > 0 Then
        Set GetIEApp = objWindows.Item(CLng(lngSingleWindow))
    Else: strReturnValue = InputBox(strMessage, "Please select Browser window")
        'If the user cancels the input box an empty string is returned
        If strReturnValue <> "" Then
        'Make sure the number selected is valid
            If Val(strReturnValue) >= 0 And Val(strReturnValue) <= intOption Then
                Set GetIEApp = objWindows.Item(CLng(strReturnValue))
            End If
        End If
    End If
End If
Set objWindow = Nothing
Set objWindows = Nothing
Set objShell = Nothing

End Function
Public Sub ClearActiveSheet()
ActiveSheet.UsedRange.Clear
ActiveSheet.Cells(2, 1).Activate
End Sub
Sub SetFields()
On Error Resume Next
Dim objIE As Object
Dim objParent As Object
Dim objInputElement As Object
Dim lngRow As Long

Set objIE = GetIEApp 'Make sure an IE object was hooked

If TypeName(objIE) = "Nothing" Then
    MsgBox "Could not hook Internet Explorer object", vbCritical, "GetFields() Error"
    GoTo Clean_Up
End If

For lngRow = 2 To ActiveSheet.UsedRange.Rows.Count
    If ActiveSheet.Cells(lngRow, cElement_SetValue) <> "" Then
    
        'If we have a parent name/ID drill to that element, otherwise point to whole document
        If ActiveSheet.Cells(lngRow, cForm_name).Text <> "" Then
            Set objParent = objIE.Document.forms(ActiveSheet.Cells(lngRow, cForm_name).Text)
        ElseIf ActiveSheet.Cells(lngRow, cForm_Id).Text <> "" Then
            Set objParent = objIE.Document.forms(ActiveSheet.Cells(lngRow, cForm_Id).Text)
        Else: Set objParent = objIE.Document.all
        End If
        
        With objParent
            If ActiveSheet.Cells(lngRow, cElement_Type) = "radio" Then
                Set objInputElement = objParent.tags("INPUT").Item(ActiveSheet.Cells(lngRow, cElement_Name).Text)
                objInputElement.Item(ActiveSheet.Cells(lngRow, cElement_ID).Text).Checked = True
                Set objInputElement = Nothing
            ElseIf ActiveSheet.Cells(lngRow, cElement_Type) = "checkbox" Then
                objParent.Item(ActiveSheet.Cells(lngRow, cElement_ID).Text).Checked = True
            Else
                objParent.Item(ActiveSheet.Cells(lngRow, cElement_Name).Text).Value = CStr(ActiveSheet.Cells(lngRow, cElement_SetValue))
            End If
        End With
        
        If Err.Number <> 0 Then
        Debug.Print "Error Writting: Row " & lngRow, ActiveSheet.Cells(lngRow, cElement_Name), ActiveSheet.Cells(lngRow, cElement_SetValue)
        Err.Clear
        End If
    End If
Next lngRow
Clean_Up:
Set objParent = Nothing
Set objIE = Nothing
End Sub
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Sort by date Sort by votes
I've only used that code for retrieving form fields as a diagnostic tool, never for setting/populating them, so I'm not sure if it works for that purpose, particularly radio buttons which you say it doesn't work with. You normally have to write custom code to suit the specific web site, not use generic code like that.

You might want to uncomment the On Error Resume Next whilst debugging the code. But it should work if you change this line in the section you highlighted:
Code: 
                    objInputElement.Item(ActiveSheet.Cells(lngRow, cElement_ID).Text).Checked = True
to:
Code: 
                    objInputElement.Item(ActiveSheet.Cells(lngRow, cElement_Name).Text)(ActiveSheet.Cells(lngRow, cElement_SetValue)).Checked = True
And in the column H cell of any row which has the same radio button name, put 0 if you want the first radio button of that name to be set, 1 for the second, etc.

For example, with HTML Forms and Input, put 0 in H6 (or H7) to select Male, or put 1 in H6 (or H7) to select Female.
 
Last edited:
Upvote 0
Perfect. Thank you!

The other three elements I need to update are:

submit
select-multiple
select-one

Do you have code to share to update these type fields?

Thank you,
Roger
 
Upvote 0
submit - do you mean submit a form? - is usually theForm.submit, where theForm is a reference to the form. For the tool, add this loop after the first loop:
Code: 
    For lngRow = 2 To ActiveSheet.UsedRange.Rows.Count
        If ActiveSheet.Cells(lngRow, cElement_Type) = "submit" Then
            Set objParent = objIE.Document.Forms(ActiveSheet.Cells(lngRow, cForm_name).Text)
            objParent.submit
        End If
    Next
For a selecting a single option in a select element (dropdown):

theSelectElement.Options(n).Selected = True
Or
theSelectElement.Options.selectedIndex = n

where theSelectElement is a reference to the HTML select element and n is the index of the option you want to select (0 = first option, 1 = second, etc.)

For a multiple select element:

theSelectElement.Options(n).Selected = True

and repeat that line for different values of n, for each option you want to select.
 
Upvote 0
Had to take a break from this but back on it. I'm struggling with the select-one.

Rich (BB code): 
With objParent
            If ActiveSheet.Cells(lngRow, cElement_Type) = "radio" Then
                Set objInputElement = objParent.tags("INPUT").Item(ActiveSheet.Cells(lngRow, cElement_Name).Text)
                objInputElement.Item(ActiveSheet.Cells(lngRow, cElement_Name).Text)(ActiveSheet.Cells(lngRow, cElement_SetValue)).Checked = True
                Set objInputElement = Nothing
            ElseIf ActiveSheet.Cells(lngRow, cElement_Type) = "checkbox" Then
                objParent.Item(ActiveSheet.Cells(lngRow, cElement_ID).Text).Checked = True
            ElseIf ActiveSheet.Cells(lngRow, cElement_Type) = "select-one" Then
                On Error GoTo 0
                Set objInputElement = objParent.tags("SELECT").Item(ActiveSheet.Cells(lngRow, cElement_Name).Options(92)).Selected = True
                                Set objInputElement = Nothing
            Else
                objParent.Item(ActiveSheet.Cells(lngRow, cElement_Name).Text).Value = CStr(ActiveSheet.Cells(lngRow, cElement_SetValue))
            End If
        End With

The alternative method did not work either. I kept getting an "oblect doesn't support proerpty" error.
 
Upvote 0
As I said, that code is a generic tool which is only suitable for reading form elements, not setting and submitting them. For a start it didn't handle radio buttons until the additional code above and now it seems it doesn't handle dropdowns.

It's better to start afresh and write code specific to the web site you're trying to automate.
 
Upvote 0
I guess that's what I'm trying to do. I'm just not that great of a code writer. I can usually take others' work and tinker with it to fit my needs.

Re-reading, I think my last post came off rude. I shouldn't have written that the code doesn't work. I should have written the I haven't been able to get the code to work, which is probably the much truer statement.

I originally found this code at the link below but there wasn't a lot of supporting information. Do you know if there are any books or anything that may cover this? I have a few books for Excel VBA but none go into something like this.

Any assistance is very much appreciated. Sorry if my last post came off rudely.
 
Upvote 0
I've navigated past the select one. This piece works now.

Code: 
ElseIf ActiveSheet.Cells(lngRow, cElement_Type) = "select-one" Then
                objParent.Item(ActiveSheet.Cells(lngRow, cElement_ID).Text).Options.selectedIndex = 94 'change per record

Below is the multiple select piece. I've tried the code both ways and can't quite get it to work. The area that's commented out returns an object doesn't support property error message. The uncommnented code does not error but doest not update the list, either.

Code: 
ElseIf ActiveSheet.Cells(lngRow, cElement_Type) = "select-multiple" Then
                On Error GoTo 0
                objParent.Item(ActiveSheet.Cells(lngRow, cElement_ID).Text).Options(3).Selected = True
                'Set objInputElement = objParent.tags("SELECT").Item(ActiveSheet.Cells(lngRow, cElement_Name).Text)
                'objInputElement.Item(ActiveSheet.Cells(lngRow, cElement_Name).Text)(ActiveSheet.Cells(lngRow, cElement_SetValue)).Options(4).Selected = True
                'Set objInputElement = Nothing

I think once I get this piece, I'll be set. :)
 
Upvote 0
Okay, multiple select is complete!

Code: 
ElseIf ActiveSheet.Cells(lngRow, cElement_Type) = "select-multiple" Then
                objParent.Item(ActiveSheet.Cells(lngRow, cElement_ID).Text).Item(5).Selected = True

I just need to add the code for the submit button and I am set.

Thank you,
Roger
 
Upvote 0
You must log in or register to reply here.

Similar threads

NessPJ
  • Question
VBA - Send Chat text to a Discord window?
Replies
2
Views
606
NessPJ
NessPJ
reasem
  • Question
Pulling Tables from Internet Explorer help (VBA)
Replies
1
Views
861
Worf
Worf
C
  • Solved
IE Print Screen Not Correct Info
Replies
8
Views
555
Joe4
Joe4
P
  • Question
IE VBA Web Scrapping Table extract issue
Replies
1
Views
1K
Worf
Worf
V
  • Solved
Could not set the List property. Permission denied - Run time error 70.
Replies
6
Views
2K
vbaNumpty
V

Forum statistics

Threads
1,216,080
Messages
6,128,692
Members
449,464
Latest member
againofsoul

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top