使用vba从html组合框填充excel用户表单组合框_Html_Vba_Excel_Combobox_Web Scraping

使用vba从html组合框填充excel用户表单组合框

html vba excel combobox web-scraping

使用vba从html组合框填充excel用户表单组合框,html,vba,excel,combobox,web-scraping,Html,Vba,Excel,Combobox,Web Scraping,我有一个用户表单，我希望html选项值填充excel组合框。基本上我想复制这些值，然后再传递它们我所拥有的是从不同的帖子中拼凑而成的，但似乎没有任何效果 Dim应用程序作为InternetExplorerMedium 将nam作为对象作为对象的暗sel Set appIE=New InternetExplorerMedium sURL=“站点信息在此显示” 和阿皮 .导航sURL .Visible=True 以在appIE.Busy或appIE.readyState 4时执行多芬特环

我有一个用户表单，我希望html选项值填充excel组合框。基本上我想复制这些值，然后再传递它们

我所拥有的是从不同的帖子中拼凑而成的，但似乎没有任何效果

Dim应用程序作为InternetExplorerMedium
将nam作为对象
作为对象的暗sel
Set appIE=New InternetExplorerMedium
sURL=“站点信息在此显示”
和阿皮
.导航sURL
.Visible=True
以
在appIE.Busy或appIE.readyState 4时执行
多芬特
环
对于IE.document.getElementsByTagName（“选择”）中的每个f
如果f=“供应商代码”，则
对于IE.document.getElementsByTagName（“选项”）中的每个选项
与Me.SupplierSite.AddItem（f.Option）一起使用
以
下一个选项
如果结束
下一个f
还尝试：
Set Doc=IE.document.forms（“NewReleaseQueueForm1”）
对于Doc.getElementsByTagName（“选择”）（0）中的每个选择
如果sel.Name=“suppliercode”，则
'循环并将每个选项添加到Me.SupplierSite
对于每个opt-In IE.document.forms（“NewReleaseQueueForm1”）.getElementsByTagName（“选项”）（0）.Value
Me.SupplierSite.AddItem选择值
下一选项
如果结束
下一个sel

HTML示例：


供应商站点
任何
T488C

请将以下HTML代码放入记事本并另存为HTML文件。在MSIE中打开该文件

然后打开一个新的干净工作簿，将下面的宏代码粘贴到标准模块中。确保您的网页已在MSIE中打开。转到编辑器，将光标放在“StartHere（）”子例程中的某个位置。按PF5运行它。将打开一个用户表单，其中包含所有打开的浏览器页面的名称。选择标题为“测试获取选择选项”的选项。一个msgbox将显示页面已成功放入Excel对象。然后检查您的工作表，看看它是否列出了A列中的四个选项

如果有效，则清除sheet1并打开网页。请重试宏，看看它是否适用于您的页面

HTML:Code

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> <html lang="en"> 
<head> 
<meta http-equiv="content-type" content="text/html; charset=utf-8"> 
<title>Test Get Select Options</title> 
</head> 
<body> 

<form id="NewReleaseQueueForm1" method="post" name="NewReleaseQueueForm1">
    <table cellpadding="4">
        <tr>
            <th valign="top">Supplier Site</th>
            <td valign="top">
                <select multiple name="suppliercode" size="5">
                    <option selected value="Any">
                        &lt;Any&gt;
                    </option>
                    <option value="T488C">
                        T488C
                    </option>
                    <option value="R488C">
                        R488C
                    </option>
                    <option value="C488C">
                        C488C
                    </option>
                    <option value="Z488C">
                        Z488C
                    </option>
                </select>
            </td>
            <td></td>
       </tr>
   </table>
</form>
</body> 
</html>

只需自己通过VB编辑器“工具”-“引用”将引用添加到干净的工作簿中。它们是“Microsoft脚本运行时”、“Microsoft窗体”、“Microsoft MSHTML”和“Microsoft Internet控件”。然后将以下代码添加到模块中并运行getOpenBrowserCreateForm（）。它已经为我工作多年了

Global myDoc As HTMLDocument
Global IE As Object


Sub getOpenBrowserCreateForm()
Dim myForm As Object
Dim NewFrame As MSForms.Frame
Dim NewButton As MSForms.CommandButton, newButton2 As MSForms.CommandButton
'Dim NewComboBox As MSForms.ComboBox
Dim NewListBox As MSForms.ListBox
'Dim NewTextBox As MSForms.TextBox
'Dim NewLabel As MSForms.Label
'Dim NewOptionButton As MSForms.OptionButton
'Dim NewCheckBox As MSForms.CheckBox
Dim x As Integer
Dim Line As Integer

'This is to stop screen flashing while creating form
Application.VBE.MainWindow.Visible = False

On Error Resume Next
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\System32\mshtml.tlb"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\System32\ieframe.dll"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\system32\scrrun.dll"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\system32\FM20.DLL"
On Error GoTo 0
Set myForm = ThisWorkbook.VBProject.VBComponents.Add(3)

'Create the User Form
With myForm
    .Properties("Caption") = "Select Open Web Site"
    .Properties("Width") = 326
    .Properties("Height") = 280
End With

'Create ListBox
Set NewListBox = myForm.designer.Controls.Add("Forms.listbox.1")
With NewListBox
    .Name = "ListBox1"
    .Top = 12
    .Left = 12
    .Width = 297
    .Height = 207.8
    .Font.Size = 9
    .Font.Name = "Tahoma"
    .BorderStyle = fmBorderStyleOpaque
    .SpecialEffect = fmSpecialEffectSunken
End With

'Create CommandButton1 Create
Set NewButton = myForm.designer.Controls.Add("Forms.commandbutton.1")
With NewButton
    .Name = "CommandButton1"
    .Caption = "Select"
    .Accelerator = "M"
    .Top = 228
    .Left = 234
    .Width = 72
    .Height = 24
    .Font.Size = 9
    .Font.Name = "Tahoma"
    .BackStyle = fmBackStyleOpaque
End With

'Create CommandButton2 Create
Set NewButton = myForm.designer.Controls.Add("Forms.commandbutton.1")
With NewButton
    .Name = "CommandButton2"
    .Caption = "Cancel"
    .Accelerator = "M"
    .Top = 228
    .Left = 144
    .Width = 72
    .Height = 24
    .Font.Size = 9
    .Font.Name = "Tahoma"
    .BackStyle = fmBackStyleOpaque
End With

'add code for form module
myForm.codemodule.insertlines 1, "Private Sub CommandButton1_Click()"
myForm.codemodule.insertlines 2, "Dim urlLocation As String"
myForm.codemodule.insertlines 3, ""
myForm.codemodule.insertlines 4, "''////////////////////////////////////////////////////////////////////"
myForm.codemodule.insertlines 5, "''  This part gets all open web pages qand displays them on the form for user to choose"
myForm.codemodule.insertlines 6, "''"
myForm.codemodule.insertlines 7, "    Set objIterator = CreateObject(" & Chr(34) & "Shell.Application" & Chr(34) & ")"
myForm.codemodule.insertlines 8, "    For X = 0 To objIterator.Windows.Count"
myForm.codemodule.insertlines 9, "        On Error Resume Next"
myForm.codemodule.insertlines 10, "        current_title = objIterator.Windows(X).Document.Title"
myForm.codemodule.insertlines 11, "        current_url = objIterator.Windows(X).Document.Location"
myForm.codemodule.insertlines 12, "    "
myForm.codemodule.insertlines 13, "        If current_title = ListBox1.Value Then 'is this my webpage?"
myForm.codemodule.insertlines 14, "        "
myForm.codemodule.insertlines 15, "            Set IE = objIterator.Windows(X)"
myForm.codemodule.insertlines 16, "            MsgBox " & Chr(34) & "IE was properly set" & Chr(34) & ""
myForm.codemodule.insertlines 17, "            "
myForm.codemodule.insertlines 18, "             Boolean_indicator = True"
myForm.codemodule.insertlines 19, "            Exit For"
myForm.codemodule.insertlines 20, "        End If"
myForm.codemodule.insertlines 21, "    Next"
myForm.codemodule.insertlines 22, "    Set objIterator = Nothing"
myForm.codemodule.insertlines 23, "    Set myDoc = IE.Document"
myForm.codemodule.insertlines 24, "Return"
myForm.codemodule.insertlines 25, "Unload Me"
myForm.codemodule.insertlines 26, ""
myForm.codemodule.insertlines 27, "End Sub"
myForm.codemodule.insertlines 28, ""
myForm.codemodule.insertlines 29, ""
myForm.codemodule.insertlines 30, "Private Sub CommandButton2_Click()"
myForm.codemodule.insertlines 31, " Unload Me"
myForm.codemodule.insertlines 32, "End Sub"
myForm.codemodule.insertlines 33, ""
myForm.codemodule.insertlines 34, ""
myForm.codemodule.insertlines 35, "Private Sub UserForm_Activate()"
myForm.codemodule.insertlines 36, "    Dim myArray1() As String, tempNumb As Integer"
myForm.codemodule.insertlines 37, "    "
myForm.codemodule.insertlines 38, "    "
myForm.codemodule.insertlines 39, "    i = 2"
myForm.codemodule.insertlines 40, "    tempNumb = 1"
myForm.codemodule.insertlines 41, "    "
myForm.codemodule.insertlines 42, "    ReDim myArray1(1 To 1)"
myForm.codemodule.insertlines 43, "   "
myForm.codemodule.insertlines 44, "    Set objShell = CreateObject(" & Chr(34) & "Shell.Application" & Chr(34) & ")"
myForm.codemodule.insertlines 45, "    Set objAllWindows = objShell.Windows"
myForm.codemodule.insertlines 46, "    "
myForm.codemodule.insertlines 47, "    "
myForm.codemodule.insertlines 48, "    For Each ow In objAllWindows"
myForm.codemodule.insertlines 49, "        If (InStr(1, ow," & Chr(34) & "Internet Explorer" & Chr(34) & ", vbTextCompare)) Then"
myForm.codemodule.insertlines 50, "            myArray1(tempNumb) = ow.Document.Title"
myForm.codemodule.insertlines 51, "            tempNumb = tempNumb + 1"
myForm.codemodule.insertlines 52, "            If Not ow.Document.Title = " & Chr(34) & "" & Chr(34) & " Then"
myForm.codemodule.insertlines 53, "                ReDim Preserve myArray1(1 To tempNumb)"
myForm.codemodule.insertlines 54, "            Else"
myForm.codemodule.insertlines 55, "                Exit For"
myForm.codemodule.insertlines 56, "            End If"
myForm.codemodule.insertlines 57, "        End If"
myForm.codemodule.insertlines 58, "    Next"
myForm.codemodule.insertlines 59, "     "
myForm.codemodule.insertlines 60, "    Me.ListBox1.List = myArray1"
myForm.codemodule.insertlines 61, "End Sub"
myForm.codemodule.insertlines 62, ""
'Show the form
VBA.UserForms.Add(myForm.Name).Show

'Delete the form (Optional)
Application.VBE.MainWindow.Visible = True

ThisWorkbook.VBProject.VBComponents.Remove myForm

'   IE is now set to the user's choice and you can add code here to interact with it
'   myDoc is now set to IE.Document also
'
'
'

Dim drp As HTMLFormElement

Set drp = myDoc.getelementsbyname("suppliercode")(0)



Dim walekuj As Long
walekuj = myDoc.forms.Length
 MsgBox walekuj

'we get the option values into our worksheet

For x = 0 To 3
 Cells(x + 1, 1) = drp.Item(x).innerText
 Next x

'Now we select the option value of our choice

drp.selectedIndex = 2

' we free memory

Set IE = Nothing
 Application.StatusBar = ""
End Sub

我让它工作。谢谢你的时间和努力为那些张贴

Set IE = IE.document.frames(1).document
Dim supls As Object
Dim suplsDrop As Object
 Set suplsDrop = IE.getElementsByTagName("OPTION")
 For Each supls In IE.getElementsByTagName("SELECT")
  If supls.Name = "suppliercode" Then
 For Each suplsDrop In supls
  With Me.SupplierSite
  .AddItem suplsDrop.Value
  End With
Next suplsDrop
End If
Next supls

如果f.name=“suppliercode”，那么？？？尝试并逐步调试它似乎不喜欢.additem，它会跳过if语句。.additem上应为函数或变量。我用我尝试过的方法更新了这个线程，尝试将行更改为“If f.NAME=“suppliercode”，然后“for循环中的一些其他代码也无法工作”。下面的链接将引导您完成从select元素获取选项的过程。它使用GetElementById方法，您可以用GetElementsByName（“suppliercode”）（0）方法替换该方法。零是必需的，因为可能有多个名为“suppliercode”的元素。0表示第一个实例，1表示第二个实例，etc etc用户定义类型未在

全局myDoc上定义为HTMLDocument，并且子实例从不存在。总是在结束子之前到达预期的结束子。我的坏。首先删除两个全局变量。添加guid引用后，它将替换它们。
Set IE = IE.document.frames(1).document
Dim supls As Object
Dim suplsDrop As Object
 Set suplsDrop = IE.getElementsByTagName("OPTION")
 For Each supls In IE.getElementsByTagName("SELECT")
  If supls.Name = "suppliercode" Then
 For Each suplsDrop In supls
  With Me.SupplierSite
  .AddItem suplsDrop.Value
  End With
Next suplsDrop
End If
Next supls