Solved: Load IE to Excel Sheet

[omnibuster]

Hi.
This code put IE website info in to cell "A1", but how put this info to in Sheet1 !

[Option Explicit
Sub GetIE()
'Requires reference to Microsoft Internet Controls
Dim SWs As SHDocVw.ShellWindows, vIE As SHDocVw.InternetExplorer
Dim wkb As Workbook
Dim wks As Worksheet
Set wks = ActiveSheet
Set wkb = wks.Parent
Set SWs = New SHDocVw.ShellWindows

For Each vIE In SWs
If Left(vIE.LocationURL, 4) = "http" Then 'avoid explorer windows/etc this way
MsgBox vIE.Document.body.innerhtml

' This Works good, but i dont need new wbk
' vFF = FreeFile
' Open "C:\Documents and Settings\kodu\Desktop\AA.xls" For Output As #vFF
' Print #vFF, vIE.Document.body.innerhtml
' Close #vFF

'Put it to a ActiveFile & ActiveSheet, but not in to one cell?
Sheets("Sheet1").Range("A1").Activate
Range("A1")..... = vIE.Document.body.innerhtml




End If
Next

Set SWs = Nothing
Set vIE = Nothing
End Sub

[hardlife]

You can try this, please no questions :-)



Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096


Function ClipBoard_GetData()

Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim MyString As String
Dim RetVal As Long

If OpenClipboard(0&) = 0 Then
MsgBox "Cannot open Clipboard. Another app. may have it open"
Exit Function
End If
hClipMemory = GetClipboardData(CF_TEXT)
If IsNull(hClipMemory) Then
MsgBox "Could not allocate memory"
GoTo OutOfHere
End If

lpClipMemory = GlobalLock(hClipMemory)

If Not IsNull(lpClipMemory) Then
MyString = Space$(MAXSIZE)
RetVal = lstrcpy(MyString, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)


MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
Else
MsgBox "Could not lock memory to copy string from."
End If

OutOfHere:

RetVal = CloseClipboard()
ClipBoard_GetData = MyString

End Function

Function ClipBoard_SetData(MyString As String)

Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, x As Long

hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
lpGlobalMemory = GlobalLock(hGlobalMemory)


lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)


If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If


If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If


x = EmptyClipboard()


hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:

If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If

End Function

Sub paste()

Dim SWs As SHDocVw.ShellWindows, vIE As SHDocVw.InternetExplorer
'Dim wkb As Workbook
'Dim wks As Worksheet
'Set wks = ActiveSheet
'Set wkb = wks.Parent
Set SWs = New SHDocVw.ShellWindows

For Each vIE In SWs
If Left(vIE.LocationURL, 4) = "http" Then 'avoid explorer windows/etc this way
'MsgBox vIE.Document.body.innerhtml

ClipBoard_SetData (vIE.Document.body.innerhtml)
SendKeys ("^v") 'Paste

End If
Next

End Sub

[omnibuster]

Very Big Thanks for you hardlife.
I am feel like i am idiot.
Of course: Clipboard.

[hardlife]

Hi omnibuster, Thanks to You, because of You me can learn something new,
me is happy it is usefull :hi:

HAPPY AND SUNNY DAY

GOOD LUCK

Pavel Humenuk

[mdmackillop]

Hi Pavel,
If you copied this from another source (no problem with that), can you please post a link?
Regards
MD

[hardlife]

many years ago me was working in Access

http://support.microsoft.com/kb/210216

HAPPY AND SUNNY DAY
no more questions :-)
Pavel Humenuk