|
[code]
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
[/code] |