|
Guten Tag,
ich benutze unten stehende vbs Datei um Texte die im Clipboard gespeichert / kopiert sind auf ein bestimmtes
Format zu konvertieren.
Seit dem Update auf Internet Explorer 11 funktioniert dieser nun nicht mehr
https://msdn.microsoft.com/de-de/library/dn384057(v=vs.85).aspx
IE11 unterstütz wohl keinen VBA mehr.
Gint es hierfür alternativen : ???
Set CB = WScript.CreateObject("htmlfile") 'Use IE to get Data
set CB = WScript.CreateObject("InternetExplorer.Application")
ich bin leider kein Experte aber konnte diese beiden Zeilen ausfindig machen die scheinbar bezug zu IE haben.
Viele Grüße
Henry
Option Explicit
'Variables
Dim CB 'ClipBoard
Dim CBData 'ClipBoard Data
Dim CBDataN 'ClipBoard Data New
Dim n 'Counter
Dim pos 'Counter
Dim Cmd 'Shell
Dim minlen 'Mindenstlänge
Dim Cursor 'Bool
'Settings
Set CB = WScript.CreateObject("htmlfile") 'Use IE to get Data
Set Cmd = WScript.CreateObject("WScript.Shell") 'Shell for PopUp
'Get Data
Cmd.PopUp "Please answer the question with YES.", 2, "Information"
CBData = CB.ParentWindow.ClipBoardData.GetData("text")
'Is Data available
if len(CBData) <= 0 or IsNull(CBData) or IsEmpty(CBData) then
'NO
MsgBox "Clipboard: No data found!", vbOKOnly + vbInformation, "Information: Abort"
WScript.Quit 1
else
'YES
CBDataN = ""
pos = 0
for n = 1 to len(CBData)
if IsNumeric(Mid(CBData, n, 1)) = true then
'Ziffern nur übertragen, wenn Positon kleiner gleich 4
pos = pos + 1
if pos <= 4 then
CBDataN = CBDataN & Mid(CBData, n, 1)
end if
else
'Leerzeilen verhindern
if pos <> 0 then
Cursor = False
'CrLf, Spaces, Kommas, Semikolons, Slashes durch Cursor-Down ersetzen
if Mid(CBData, n, 1) = Chr(10) then Cursor = True
if Mid(CBData, n, 1) = Chr(13) then Cursor = True
if Mid(CBData, n, 1) = "," then Cursor = True
if Mid(CBData, n, 1) = ";" then Cursor = True
if Mid(CBData, n, 1) = "/" then Cursor = True
if Mid(CBData, n, 1) = " " then Cursor = True
'Wenn Umbruch
if Cursor = true then
'Mindestlänge mit Nullen auffüllen
if pos = 1 then CBDataN = CBDataN & "000"
if pos = 2 then CBDataN = CBDataN & "00"
if pos = 3 then CBDataN = CBDataN & "0"
'Cursor-Down einfügen
CBDataN = CBDataN & Chr(27) & "[B"
'Position reseten
pos = 0
end if
end if
end if
next
'Generate a new Instance
CB.Close
set CB = WScript.CreateObject("InternetExplorer.Application")
CB.Navigate("about:blank")
CB.Visible = False
Do Until CB.ReadyState = 4
WScript.Sleep 100
Loop
'Copy to ClipBoard
Cmd.PopUp "Please answer the question with YES.", 2, "Information"
CB.Document.parentWindow.clipboardData.setData "Text", CBDataN
CB.Quit
WScript.Quit 0
end if
WScript.Quit 2 |