MyTetra Share
Делитесь знаниями!
буфера обмена
31.07.2019
22:37
Текстовые метки: буфера обмена,Shell
Раздел: !Закладки - VBA

Получить текст из буфера обмена

Код (vb.net):

GetFromClipBoard = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")

Скопировать текст в буфер обмена (используется временный файл HTA)

Код (vb.net):

Sub CopyToClipBoard(Data)
    Const QT = """"
    Dim oShell: set oShell = CreateObject("WScript.Shell")
    Dim oFSO:   set oFSO   = CreateObject("Scripting.FileSystemObject")
    Dim cur:  cur = oFSO.GetParentFolderName(WScript.ScriptFullName)
    Dim BuferServer: BuferServer = oFSO.BuildPath(cur, "SetClipBoard.hta")
    if not oFSO.FileExists(BuferServer) then
        on error resume next
        Dim oTS: set oTS = oFSO.OpenTextFile(BuferServer,2,true)
        if Err.Number <> 0 then ' не хватает прав для распаковки ресурса в папку со скриптом - распаковую в папку %temp%
            Err.Clear
            Dim temp: temp = oShell.ExpandEnvironmentStrings("%temp%")
            BuferServer = oFSO.BuildPath(temp, "SetClipBoard.hta")
            set oTS = oFSO.OpenTextFile(BuferServer,2,true)
        end if
        oTS.WriteLine "<html><head><HTA:APPLICATION ID=""objHTA"" WindowState=""minimize"" ShowInTaskbar=""yes""/></head>"
        oTS.WriteLine "<script language=""VBScript"">Sub Window_onLoad(): comm = objHTA.CommandLine"
        oTS.WriteLine "document.parentwindow.clipboardData.SetData ""text"", mid(comm, instr(2, comm, chr(34)) + 2)"
        oTS.WriteLine "window.close(): End Sub </script></html>"
        oTS.Close: set oTS = Nothing
        on error goto 0
    end if
    if oFSO.FileExists(BuferServer) then
        Dim windir: windir = oShell.ExpandEnvironmentStrings("%windir%") 'Получаем путь к серверу HTA
        oShell.Run windir & "\system32\mshta.exe " & QT & BuferServer & QT & " " & QT & Data & QT, 0, false
    end if
    Set oFSO = Nothing: set oShell = Nothing
End Sub

Упрощенный вариант:

Код (vb.net):

Sub CopyToClipBoard(Data)
    Dim oShell: set oShell = CreateObject("WScript.Shell")
    Dim mshta: mshta = oShell.ExpandEnvironmentStrings("%windir%") & "\system32\mshta.exe" 'Получаем путь к серверу HTA
    oShell.Run mshta & " ""vbscript:document.parentwindow.clipboardData.SetData(""text"",replace(""" & replace(Data," ","$#@!~%") & """,""$#@!~%"",chr(32)))&close()""",0,false
End Sub


Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования