Copy outside Clipboard contents (html page) to a cell in Excel

[sifar]

hi,

I am trying to copy the contents of a clipboard which was copied from
an html file which has 2 verticals columns viz, 1st column for labels
& 2nd column for Values.
e.g.

first Name | abc
Last Name | fgh
Tel | 12345678
error | flashing adsl

etc.....

I am copying the 2nd column (values) to clipboard by selecting the
cells from top to bottom on html page.

when i goto excel sheet (which has similar 1st column labels in the
first row), i want to place these values under the respective labels
horizontally (transpose).

The below code in Sheet1 does not seem to work.

Please Help!

Warm Rgds,

Sifar
============================================
Option Explicit
Dim MyDataObj As DataObject
Dim LastRow As Long

Public Function GetOffClipboard() As Variant
Dim MyDataObj As New DataObject
MyDataObj.GetFromClipboard
GetOffClipboard = MyDataObj.GetText()
End Function

Sub PasteTxT()
With Worksheets(1)
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastRow = LastRow + 1
.UsedRange.Cells(LastRow, "A").Activate
.Range(ActiveCell, ActiveCell).PasteSpecial_ Paste:=xlPasteValues,
Transpose:=True = GetOffClipboard()
End With
End Sub
================================================

 

[Tim Williams]

You might be better off automating IE and getting the values directly
from the web page instead of using copy/paste.

If the layout of the page is always the same then you should be read
the (eg) table values directly into Excel.

This function will get you a reference to the HTML document object,
when passed a URL to a (already loaded) page:
'Find an IE window with matching location and get a reference
' to the document object from the loaded page. Assumes no frames.
Function GetHTMLDocument(sAddress As String) As Object


Dim objShell As Object, objShellWindows As Object, o As Object
Dim retVal As Object, sURL As String


Set retVal = Nothing
Set objShell = CreateObject("Shell.Applicatio­n")
Set objShellWindows = objShell.Windows


'see if IE is already open
For Each o In objShellWindows
sURL = ""
On Error Resume Next
sURL = o.Document.Location
On Error GoTo 0
If sURL <> "" Then
If sURL Like sAddress & "*" Then
Set retVal = o.Document
Exit For
End If
End If
Next o


Set GetHTMLDocument = retVal
End Function

Eg:

set o = GetHTMLDocument("http://someserver/somepage.html")
Set el = o.getElementsByTagName("table")
With el(0) 'adjust to suit
MsgBox .Rows(2).Cells(0).innerText 'adjust to suit
MsgBox .Rows(2).Cells(1).innerText 'adjust to suit
End With


Tim

 

[sifar]

hi, thanks for the message. since i am an amateur to programming, i did
not understand the above. where do i put this code, in Excel or in
html. Please advice.

what if the table is on an email message (*.msg) file??? which it
is.....i am sorry....

I want to use the GetfromClipboard method in excel which is not working
properly.

otherwise i have to select & copy contents of table to an excel sheet.
theyget pasted in a column, then i have to select the column & run the
PasteSpecial option, to transpose values horizontally. Its a waste of
time!!

Please help me why its not working?

Rgds,

Sifar

 

[Tim Williams]

Not sure your approach will work - I don't get a "values" option when
doing this manually in Excel.

Your best bet might be to "manually" parse the data out of the
GetOffClipboard() return value (which seems to be plain text). Each
line in the return value will be one line from your copied table, so
loop through the rows and look for the values in the first column and
replace those with ""

This worked for me with table content copied from
http://www.w3schools.com/html/html_tables.asp
("table tags" table near the bottom of the page)

Good luck
Tim.

Sub TxT()
Dim arr As Variant

arr = Split(GetOffClipboard(), vbCrLf)
With ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1,
0).EntireRow
.Cells(1) = FindLine(arr, "<tbody>")
.Cells(2) = FindLine(arr, "<tr>")
.Cells(3) = FindLine(arr, "<td>")
End With

End Sub

Function FindLine(arr As Variant, sInfoHeader As String)
Dim x

For x = 0 To UBound(arr)
If arr(x) Like sInfoHeader & "*" Then
FindLine = Trim(Right(arr(x), Len(arr(x)) _
- Len(sInfoHeader)))
Exit Function
End If
Next x
FindLine = ""
End Function



Public Function GetOffClipboard() As Variant
Dim MyDataObj As New DataObject
MyDataObj.GetFromClipboard
GetOffClipboard = MyDataObj.GetText()
End Function

 

[sifar]

hi,

The below code works fine for me, with the exception that i cannot
paste it to the row.

I could not understand your code.

Attribute VB_Name = "Module1"
Option Explicit
Dim LastRow As Long

Public Function GetOffClipboard() As Variant
Dim MyDataObj As New DataObject
MyDataObj.GetFromClipboard
GetOffClipboard = MyDataObj.Gettext()
End Function

Sub PasteTxT()
On Error Resume Next 'had to put an error handler to avoid copy/paste
errors...
With ActiveWorkbook.Worksheets(2)
.Activate
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
.UsedRange.Cells(LastRow + 1, "A").Activate
ActiveCell.Select
msgbox(GetOffClipboard) 'To check if clipboard has text..
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=True
End With
End Sub

Unable to paste text into the rows....thats all...wants to acheive that
.....will really help in speeding up copying data from outside
applications like a mail message(*.msg).

Rgds,

Sifar

 

[sifar]

............Also, i have made a code to generate a Custom button when
the workbook opens (placed it in Workbook_Open() )

_________
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i
For Each i In Application.CommandBars("Formatting")
..Controls.Delete
Next i
'myControl.Delete
'Application.CommandBars("Formatting").Controls(myControl).Delete
End Sub

Private Sub Workbook_Open()
Dim myControl
Set myControl = Application.CommandBars("Formatting").Controls _
..Add(Type:=msoControlButton, ID:=2950, Before:=19)
With myControl
.DescriptionText = "Pastes the Data from Windows Clipboard"
.Caption = "Paste the Clipboard"
.OnAction = "PasteTxT"
.Style = msoButtonIconAndCaption
End With
End Sub

i want to delete the custom button on Workbook close. i dont know how
to do that_

Please help!

Rgds,

Sifar

 

[sifar]

............Also, i have made a code to generate a Custom button when
the workbook opens (placed it in Workbook_Open() )

_________
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i
For Each i In Application.CommandBars("Formatting")
..Controls.Delete
Next i
'myControl.Delete
'Application.CommandBars("Formatting").Controls(myControl).Delete
End Sub

Private Sub Workbook_Open()
Dim myControl
Set myControl = Application.CommandBars("Formatting").Controls _
..Add(Type:=msoControlButton, ID:=2950, Before:=19)
With myControl
.DescriptionText = "Pastes the Data from Windows Clipboard"
.Caption = "Paste the Clipboard"
.OnAction = "PasteTxT"
.Style = msoButtonIconAndCaption
End With
End Sub

i want to delete the custom button on Workbook close. i dont know how
to do that_

Please help!

Rgds,

Sifar

 

[sifar]

............Also, i have made a code to generate a Custom button when
the workbook opens (placed it in Workbook_Open() )

_________
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i
For Each i In Application.CommandBars("Formatting")
..Controls.Delete
Next i
'myControl.Delete
'Application.CommandBars("Formatting").Controls(myControl).Delete
End Sub

Private Sub Workbook_Open()
Dim myControl
Set myControl = Application.CommandBars("Formatting").Controls _
..Add(Type:=msoControlButton, ID:=2950, Before:=19)
With myControl
.DescriptionText = "Pastes the Data from Windows Clipboard"
.Caption = "Paste the Clipboard"
.OnAction = "PasteTxT"
.Style = msoButtonIconAndCaption
End With
End Sub

i want to delete the custom button on Workbook close. i dont know how
to do that_

Please help!

Rgds,

Sifar

 

[sifar]

............Also, i have made a code to generate a Custom button when
the workbook opens (placed it in Workbook_Open() )

_________
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i
For Each i In Application.CommandBars("Formatting")
..Controls.Delete
Next i
'myControl.Delete
'Application.CommandBars("Formatting").Controls(myControl).Delete
End Sub

Private Sub Workbook_Open()
Dim myControl
Set myControl = Application.CommandBars("Formatting").Controls _
..Add(Type:=msoControlButton, ID:=2950, Before:=19)
With myControl
.DescriptionText = "Pastes the Data from Windows Clipboard"
.Caption = "Paste the Clipboard"
.OnAction = "PasteTxT"
.Style = msoButtonIconAndCaption
End With
End Sub

i want to delete the custom button on Workbook close. i dont know how
to do that_

Please help!

Rgds,

Sifar

 

[sifar]

............Also, i have made a code to generate a Custom button when
the workbook opens (placed it in Workbook_Open() )

_________
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i
For Each i In Application.CommandBars("Formatting")
..Controls.Delete
Next i
'myControl.Delete
'Application.CommandBars("Formatting").Controls(myControl).Delete
End Sub

Private Sub Workbook_Open()
Dim myControl
Set myControl = Application.CommandBars("Formatting").Controls _
..Add(Type:=msoControlButton, ID:=2950, Before:=19)
With myControl
.DescriptionText = "Pastes the Data from Windows Clipboard"
.Caption = "Paste the Clipboard"
.OnAction = "PasteTxT"
.Style = msoButtonIconAndCaption
End With
End Sub

i want to delete the custom button on Workbook close. i dont know how
to do that_

Please help!

Rgds,

Sifar