Möglichkeit auf Java Inhalte per VBA zuzugreifen
27.10.2013 22:54:28
Jenny
hab ein Makro, das mir wenn ich in der Zwischenablage eine in HTML geschriebene Internetseite stehen habe, den Text und die Hyperlinks, aber nicht die Bilder einfügt.
Ich hätte eine Bitte, falls das möglich ist, kann man das so umschreiben, dass es funktioniert, wenn die Quellinternetseite nicht HTML, sondern Java ist?
Option Explicit
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" ( _
ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" ( _
ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function lstrlenA Lib "kernel32.dll" ( _
ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function lstrcpyA Lib "kernel32.dll" ( _
ByVal lpString1 As Any, _
ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function RegisterClipboardFormatA Lib "user32.dll" ( _
ByVal lpString As String) As Long
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" ( _
ByVal wFormat As Long) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" ( _
ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" ( _
ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long
Public Sub InsertHtml()
Dim strReturn As String
Dim avntTemp As Variant
Dim ialngIndex As Long, lngEmptyLines As Long
strReturn = HTMLFromClipboard
If strReturn vbNullString Then
avntTemp = Split(strReturn, vbNewLine)
For ialngIndex = LBound(avntTemp) To UBound(avntTemp)
If avntTemp(ialngIndex) = vbNullString Then _
lngEmptyLines = lngEmptyLines + 1
Next
Cells(1, 1).Resize(UBound(avntTemp) - lngEmptyLines, 1).Value = _
Application.Transpose(avntTemp)
Else
MsgBox "Kein HTML im Clipboard"
End If
End Sub
Private Function HTMLFromClipboard() As String
Dim lngFormatHTML As Long
Dim lngPtrHandle As LongPtr, lngPtrPointer As LongPtr
Dim strText As String
lngFormatHTML = RegisterClipboardFormatA("HTML Format")
If IsClipboardFormatAvailable(lngFormatHTML) Then
Call OpenClipboard(CLngPtr(Application.hWnd))
lngPtrHandle = GetClipboardData(lngFormatHTML)
lngPtrPointer = GlobalLock(lngPtrHandle)
strText = Space$(lstrlenA(ByVal lngPtrPointer))
Call lstrcpyA(strText, ByVal lngPtrPointer)
Call GlobalUnlock(lngPtrPointer)
Call CloseClipboard
HTMLFromClipboard = strText
End If
End Function