View Full Version : Solved: Load IE to Excel Sheet
omnibuster
05-09-2009, 03:17 AM
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
05-09-2009, 11:57 AM
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
05-09-2009, 01:24 PM
Very Big Thanks for you hardlife.
I am feel like i am idiot.
Of course: Clipboard.
hardlife
05-10-2009, 12:53 AM
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
05-10-2009, 03:18 AM
Hi Pavel,
If you copied this from another source (no problem with that), can you please post a link?
Regards
MD
hardlife
05-10-2009, 05:38 AM
many years ago me was working in Access
http://support.microsoft.com/kb/210216
HAPPY AND SUNNY DAY
no more questions :-)
Pavel Humenuk
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.