hi,


I am trying to copy the contents of a clipboard which was copied from
an email .msg file which has 2 verticals columns viz, 1st column for
labels & 2nd column for Values (made from drawing Textboxes. Email
message is in html format not rich text or plain text.
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 module does not seem to work.
============================================
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(Activesheet.Name)
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
================================================

So my Friend Tim Williams gave me some suggestions.....

==============================================
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
----------------------------------------------------
.......which i cannot apply as its not a HTML page

the table is on an email message (*.msg) file.

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.
they get pasted in a column, then i have to select the column & run the
PasteSpecial option, to transpose values horizontally. Its a waste of
time!!

Not sure your approach will work - I don't get a "values" option when
doing this manually in Excel.
---------------------------------------
to which my friend Tim Williams replied......
---------------------------------------

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

----------------------------------------
to which I replied..............
----------------------------------------
I could not understand your code.

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

In MY Code above....if i put Msgbox(GetOffClipboard)
i get the message box showing all the text copied on clipboard properly
indicating that its GetOffClipboard function is working properly, but i
am not able to transpose the text horizontally in to each & every cell
in the row.
I want to acheive that & its not happening. My friend Tim tried to help
me, but i donot understand his code fully ( ido understand that he has
taken the code in an Array & then comparing each & every string with
the html headers.

And it only works with the website he has stated above. what if i want
to copy each text on any html page & then place each word horizontally
(transpose it) to each cell in a row ????

Please HELP ASAP!

Rgds,

Sifar