求问：excel VBA对一个已经打开的网页进行 *** 作

'准备工作：1用IE打开百度

          2调用函数GetIE

'代码搜索标题包含百度的IE窗口，然后控制打开hao123，最后保存为c:\myhtmltxt

Option Explicit

  '

  '   工程要引用  "Microsoft   HTML   Object   Library"

  '

    

Private Type UUID

      Data1   As Long

      Data2   As Integer

      Data3   As Integer

      Data4(0 To 7)       As Byte

End Type

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long

Private Declare Function GetClassName Lib "user32" _

      Alias "GetClassNameA" ( _

      ByVal hWnd As Long, _

      ByVal lpClassName As String, _

      ByVal nMaxCount As Long) As Long

Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean

Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long

  

Private Declare Function RegisterWindowMessage Lib "user32" _

      Alias "RegisterWindowMessageA" ( _

      ByVal lpString As String) As Long

  

Private Declare Function SendMessageTimeout Lib "user32" _

      Alias "SendMessageTimeoutA" ( _

      ByVal hWnd As Long, _

      ByVal msg As Long, _

      ByVal wParam As Long, _

      lParam As Any, _

      ByVal fuFlags As Long, _

      ByVal uTimeout As Long, _

      lpdwResult As Long) As Long

              

Private Const SMTO_ABORTIFHUNG = &H2

  

Private Declare Function ObjectFromLresult Lib "oleacc" ( _

      ByVal lResult As Long, _

      riid As UUID, _

      ByVal wParam As Long, _

      ppvObject As Any) As Long

Dim IEhwnd As Long

Dim IEserver As Long

'

'   IEDOMFromhWnd

'

'   Returns   the   IHTMLDocument   interface   from   a   WebBrowser   window

'

'   hWnd   -   Window   handle   of   the   control

'

Function IEDOMFromhWnd() As IHTMLDocument

Dim IID_IHTMLDocument     As UUID

Dim hWnd   As Long

Dim lRes   As Long

Dim lMsg   As Long

Dim hr     As Long

    '   Find   a   child   IE   server   window

    EnumWindows AddressOf EnumWindowProc, ByVal 0

    If IEhwnd Then EnumChildWindows IEhwnd, AddressOf EnumChildProc, ByVal 0

    If IEserver Then hWnd = IEserver Else Exit Function

    

    '   Register   the   message

    lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")

    '   Get   the   object   pointer

    Call SendMessageTimeout(hWnd, lMsg, 0, 0, _

                    SMTO_ABORTIFHUNG, 1000, lRes)

    If lRes Then

          '   Initialize   the   interface   ID

          With IID_IHTMLDocument

                Data1 = &H626FC520

                Data2 = &HA41E

                Data3 = &H11CF

                Data4(0) = &HA7

                Data4(1) = &H31

                Data4(2) = &H0

                Data4(3) = &HA0

                Data4(4) = &HC9

                Data4(5) = &H8

                Data4(6) = &H26

                Data4(7) = &H37

          End With

          '   Get   the   object   from   lRes

          hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)

    End If

End Function

  

Private Function IsIEServerWindow(ByVal hWnd As Long) As Boolean

Dim lRes     As Long

Dim sClassName     As String

    sClassName = GetClsName(hWnd)

    IsIEServerWindow = StrComp(sClassName, "Internet Explorer_Server", vbTextCompare) = 0

End Function

'返回窗口类名

Public Function GetClsName(ByVal hWnd As Long) As String

Dim lRes     As Long

Dim sClassName     As String

    sClassName = String$(200, 0)

    lRes = GetClassName(hWnd, sClassName, Len(sClassName))

    GetClsName = Left$(sClassName, lRes)

End Function

'返回窗口标题

Public Function GetWinTitle(ByVal lhWnd As Long) As String

    Dim MyStr As String

    MyStr = String(200, Chr$(0))

    GetWindowText lhWnd, MyStr, 200

    GetWinTitle = Left(MyStr, InStr(MyStr, Chr$(0)) - 1)

End Function

Function EnumWindowProc(ByVal hWnd As Long, ByVal lParam As Long) As Long

Dim sIEtitle As String

    sIEtitle = GetWinTitle(hWnd)

    If InStr(1, sIEtitle, "百度") Then  '搜索标题包含baidu的窗口

        IEhwnd = hWnd

    Else

        EnumWindowProc = 1

    End If

End Function

Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long

    If IsIEServerWindow(hWnd) Then

        IEserver = hWnd

    Else

        EnumChildProc = 1

    End If

End Function

Function GetIE() As Long

    Dim Doc As IHTMLDocument2

    Dim s As String

    Set Doc = IEDOMFromhWnd

    If Not Doc Is Nothing Then

        Docurl = ">

如果用下拉框，你的载体是什么？

可以用某个单元格直接实现，可以选中此单元格，点数据——数据有效性——改为序列——值为“男,女”（不含引号，英文逗号）；

也可以用ActiveX控件的下拉框也就是ComboBox来实现，这个就需要用VBA代码实现，combobox1itemadd "男"

combobox1itemadd “女”

首先，你需要确定网页对象有没有可以被VBA识别的属性和方法，如果没有，你可以检查网页的源代码，看看有没有可以用来解析的属性和指令。然后，你可以使用VBA的DOM方法来访问网页对象，如documentgetElementByID()方法，来获取网页对象的属性或方法，如果能够获取到属性和方法，可以在VBA中使用这些属性和方法，进行编译。

取得文本比如说是TXT

for x=1 to len(TXT)

k=k+1

if k mod 1000 =0 then

DebugPrint mid(txt,k+1,1000)

end if

next

您调试一下思路是这样

出现这个问题倒是没想到！

但是PHP生成的静态HTML页面中，这些号码就是星号：

<td class='im' id='w0'>,,,,</td>

<td style='display:none;' class="c" n='w0'>QMTEsMDcsMDUsMDgsMDQ=M</td>

<td>2014-03-31 22:00:00</td>

</tr>

你可以打开加载完成后的网页源代码查看。

研究了一下，其实第三列的那串字符其实就是开奖号码，需要转换一下，对照规则如下：

MDE = 01  

MDI = 02  

MDM = 03  

MDQ = 04  

MDU = 05  

MDY = 06  

MDc = 07  

MDg = 08  

MDk = 09  

MTA = 10  

MTE = 11  

所以，有了以下代码：

Sub 宏1()

Dim rng As Range, i, d As New Dictionary

    If ActiveSheetQueryTablesCount > 0 Then '若已有数据连接，则直接刷新

        ActiveSheetQueryTables(1)Refresh BackgroundQuery:=False

    Else '否则建立数据连接

        With ActiveSheetQueryTablesAdd(Connection:= _

            "URL;

以上代码需要引用 Microsoft Scripting Runtime

以上就是关于求问：excel VBA对一个已经打开的网页进行 *** 作全部的内容，包括:求问：excel VBA对一个已经打开的网页进行 *** 作、什么是vba、vba如何在网页下拉选单选取某项等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！