Good day,

I was using the below code to data in the clipboard and to paste it in the Format I need.
Now since updating Internet Explorer to IE11 it doesnt work anymore.


Does this mean IE11 doesnt Support any kind of VBA anymore ?
Im no expert and barely could identify two rows in the code that might be the reason for not working anymore:
Set CB = WScript.CreateObject("htmlfile") 'Use IE to get Data
set CB = WScript.CreateObject("InternetExplorer.Application")

Can anyone help me to Change it and make it working again ?

best regards
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