如何用获得IE地址栏中的地址？

[wozhy]

请高手指教！

[TechnoFantasy]

一个获得IE中文本的代码：

Dim dWinFolder As New ShellWindows
Dim WithEvents eventIE As WebBrowser_V1

Private Sub Command1_Click()
Dim objIE As Object

For Each objIE In dWinFolder
If objIE.LocationURL = List1.List(List1.ListIndex) Then
Set eventIE = objIE
Command1.Enabled = False
List1.Enabled = False
Text1.Text = ""
Exit For
End If
Next
End Sub

Private Sub eventIE_NavigateComplete(ByVal URL As String)
Text1.Text = Text1.Text + Chr(13) + Chr(10) + URL
End Sub

在运行前。点击菜单 Projects ¦ References 项，在Available References 列表中选择Microsoft Internet Controls项将Internet对象引用介入到工程中

Private Sub Form_Load()
Dim objIE As Object

For Each objIE In dWinFolder
If InStr(1, objIE.FullName, "IEXPLORE.EXE", vbTextCompare) <> 0 Then
List1.AddItem objIE.LocationURL
End If
Next
Command1.Caption = "正文"
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set dWinFolder = Nothing
End Sub

Private Sub List1_Click()
Dim objDoc As Object
Dim objIE As Object

For Each objIE In dWinFolder
If objIE.LocationURL = List1.List(List1.ListIndex) Then
Set objDoc = objIE.Document

For i = 1 To objDoc.All.length - 1
If objDoc.All(i).tagname = "BODY" Then
Text1.Text = objDoc.All(i).innerText
End If
Next
Exit For
End If
Next
End Sub

将objDoc.All.length改为objDoc.location就可以获得IE窗口的URL

[wgku]

TechnoFantasy有两万多分。。。。高手。。！！

[vcshcn]

找到句柄，发一条消息

[lou_df]

在注册表里找一下。

[dbcontrols]

playyuer(女㊣爱) ( ) 信誉：94 ?版主的信誉也在减少?

[sonicdater]

模块名：找到 当前 IE 的URL， 并设定自己的 URL
================================================================
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any _
) As Long
Private Declare Function GetWindow Lib "user32" ( _
ByVal hwnd As Long, _
ByVal wCmd 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 Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_SETTEXT = &HC
Private Const WM_KEYDOWN = &H100
Private Const VK_RETURN = &HD

Private Const MAX_PATH = 260

Public Function GetURL() As String
Dim sIEClassName As String, hIE As Long, lngRep As Long
Dim sText As String * 255, sClass As String * 255
Dim iNum As Long, hwndChild As Long, lngRepClassName As Long
Dim lngLength As Long, sURL As String

On Error GoTo Fin
sIEClassName = "IEFrame"
hIE = FindWindow(sIEClassName, vbNullString)
If hIE <> 0 Then
hwndChild = hIE
hwndChild = hwndFindWindow(hwndChild, "WorkerW")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ReBarWindow32")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ComboBoxEx32")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ComboBox")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "Edit")
If hwndChild = 0 Then Err.Raise 10
GetURL = ExtractURL(hwndChild)
End If
Exit Function
Fin:
MsgBox "Erreur"
End Function

Public Function SetURL(sNewURL As String)
Dim sIEClassName As String, hIE As Long, lngRep As Long
Dim sText As String * 255, sClass As String * 255
Dim iNum As Long, hwndChild As Long, lngRepClassName As Long
Dim lngLength As Long, sURL As String

On Error GoTo Fin
sIEClassName = "IEFrame"
hIE = FindWindow(sIEClassName, vbNullString)
If hIE <> 0 Then
hwndChild = hIE
hwndChild = hwndFindWindow(hwndChild, "WorkerW")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ReBarWindow32")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ComboBoxEx32")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "ComboBox")
If hwndChild = 0 Then Err.Raise 10
hwndChild = hwndFindWindow(hwndChild, "Edit")
If hwndChild = 0 Then Err.Raise 10
lngRep = SendMessage(hwndChild, WM_SETTEXT, 0, ByVal sNewURL)
lngRep = SendMessage(hwndChild, WM_KEYDOWN, VK_RETURN, 0)
End If
Exit Function
Fin:
MsgBox "Erreur"
End Function

Private Function SupprimeNull(sM As String) As String
If (InStr(sM, Chr(0)) > 0) Then
sM = Left(sM, InStr(sM, Chr(0)) - 1)
End If
SupprimeNull = sM
End Function

Private Function ExtractURL(hwnd As Long) As String
Dim lngLength As Long, sURL As String, lngRep As Long

lngLength = SendMessage(hwnd, WM_GETTEXTLENGTH, 0, ByVal 0)
sURL = Space(lngLength + 1)
lngRep = SendMessage(hwnd, WM_GETTEXT, lngLength + 1, ByVal sURL)
ExtractURL = SupprimeNull(sURL)
End Function

Private Function hwndFindWindow(hwndParent As Long, sClassName As String) As Long
Dim hwndChild As Long, sClass As String * MAX_PATH
Dim bTrouve As Boolean, lngRepClassName As String

hwndChild = GetWindow(hwndParent, GW_CHILD)
'on regarde la classe du premier enfant
lngRepClassName = GetClassName(hwndChild, sClass, 255)
If Left(sClass, lngRepClassName) = sClassName Then
hwndFindWindow = hwndChild
Exit Function
End If
If hwndChild = 0 Then Exit Function 'il n'a pas d'enfant

bTrouve = False
Do Until bTrouve
hwndChild = GetWindow(hwndChild, GW_HWNDNEXT)
If hwndChild = 0 Then Exit Do 'on a tout parcouru
lngRepClassName = GetClassName(hwndChild, sClass, MAX_PATH)
If Left(sClass, lngRepClassName) = sClassName Then
hwndFindWindow = hwndChild
Exit Function
End If
Loop
End Function

[dbcontrols]

http://go8.163.com/aijun/document.html
通过实例学习窗口函数-取得IE地址栏的地址 下载

[dbcontrols]

TechnoFantasy叫陈锐

[Alsen]

找到句柄，发消息

[网络咖啡]

学习，高手真多啊

[playyuer]

'引用 Microsoft Internet Controls
Dim x As New SHDocVw.ShellWindows
Dim i As Long
For i = 0 To x.Count - 1
If VBA.TypeName(x.Item(i).Document) = "HTMLDocument" Then
Debug.Print x.Item(i).LocationURL 'URL
Debug.Print x.Item(i).Document.documentElement.outerhtml 'HTML 源
End If
Next i