cmdln
cmdln

Reputation: 97

Excel VBA paste from external program

I need to paste into Excel from an external program them move onto the next line. I have this code so far that works when I manually run it.

Sub Paste_From_External()
    ActiveCell.PasteSpecial Paste:=xlPasteValues
    ActiveCell.Offset(1).Select
End Sub

My question is how can I have Excel listen for new clipboard data and only paste when new data hits the clipboard?

Upvotes: 0

Views: 3517

Answers (3)

user6432984
user6432984

Reputation:

Clipboard Viewer

I modified this VB6 example Clipboard Viewer/Monitor OCX to efficiently monitor the ClipBoard.

StartViewer True

  • Hooks the Excel Application Window
  • WndProc will now receive any Application Window messages
  • SetClipboardViewer places the Application Window into the Clipboard Viewer Chain. Once in the chain the Application Window will receive ClipBoard change messages.

Option Explicit
' http://www.freevbcode.com/ShowCode.asp?ID=1306

Public mNextClip As Long, mPrevHandle As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function SetClipboardViewer Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ChangeClipboardChain Lib "user32" (ByVal hwnd As Long, ByVal hWndNext As Long) As Long
Public Const WM_CHANGECBCHAIN = &H30D
Public Const WM_DRAWCLIPBOARD = &H308
Public Const GWL_WNDPROC = (-4)
Public Const GWL_HINSTANCE = (-6)
Public Const GWL_HWNDPARENT = (-8)
Public Const GWL_ID = (-12)
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const GWL_USERDATA = (-21)
Public Const WM_LBUTTONDBLCLK = &H203

Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Select Case Msg
        Case WM_DRAWCLIPBOARD
            'The clipboard is changed.
            'A trick here, send a double click message to _
             the usercontrol and then raise ClipboardChanged event
            SendMessage hwnd, WM_LBUTTONDBLCLK, 0, 0
            SendMessage mNextClip, Msg, wParam, lParam

            PrintClipBoard
        Case WM_CHANGECBCHAIN
            'Another clipboard viewer closed
            If mNextClip = wParam Then
                mNextClip = lParam
            Else
                SendMessage mNextClip, Msg, wParam, lParam
            End If
    End Select

    WndProc = CallWindowProc(mPrevHandle, hwnd, Msg, wParam, lParam)

End Function

Public Sub SubClass(mHandle As Long, mAddress As Long)

    mPrevHandle = GetWindowLong(mHandle, GWL_WNDPROC)
    SetWindowLong mHandle, GWL_WNDPROC, mAddress
    mNextClip = SetClipboardViewer(mHandle)
End Sub

Public Sub UnSubClass(mHandle As Long)

    SetWindowLong mHandle, GWL_WNDPROC, mPrevHandle
    ChangeClipboardChain mHandle, mNextClip
End Sub

Sub StartViewer(StartViewer As Boolean)
    If StartViewer Then
        SubClass Application.hwnd, AddressOf WndProc
    Else
        UnSubClass Application.hwnd
    End If

End Sub

Sub PrintClipBoard()
    Dim temp As String
    Dim clip As DataObject
    Set clip = New DataObject
    clip.GetFromClipboard

    On Error Resume Next
    temp = clip.GetText
    Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1).Value = temp
    On Error GoTo 0

End Sub

Resources:

Upvotes: -1

user6432984
user6432984

Reputation:

Here is rather a crude but effective way of monitoring the clipboard.

  • Test if the clipboard has data
  • Paste new Data
  • Clear ClipBoard
  • Wait 1 Second
  • Start Over

Private Declare Function OpenClipboard Lib "User32.dll" (ByVal hWndNewOwner As Long) As Long
Private Declare Function EmptyClipboard Lib "User32.dll" () As Long
Private Declare Function CloseClipboard Lib "User32.dll" () As Long
Private Declare Function CountClipboardFormats Lib "user32" () As Long
Private Declare Function hasClipBoardData Lib "user32" Alias "CountClipboardFormats" () As Boolean

Public Sub ClearClipboard()
    Dim Ret

    Ret = OpenClipboard(0&)
    If Ret <> 0 Then Ret = EmptyClipboard
    CloseClipboard
End Sub

Sub Paste_From_External()
    Dim cell As Range

    Do While True

        If hasClipBoardData Then
            ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, DisplayAsIcon:=False
            ActiveCell.Offset(1).Select
            ClearClipboard
        End If

        Application.Wait Now + TimeValue("0:00:01")   'Wait for 1 second

        DoEvents

    Loop

End Sub

Refernce:Get text from clipboard using GetText - avoid error on empty clipboard

You could also hook the ClipBoard event using API calls. Here is an example in VB.Net: Monitoring clipboard for changes. I was able to get the callback but could not get the data to paste.

Upvotes: 1

Karthick Gunasekaran
Karthick Gunasekaran

Reputation: 2713

Try with below code. It will copy the latest clipboard data into excel

Sub test()
    Dim getallformat
    getallformat = Application.ClipboardFormats
    For Each crnt In getallformat
        If crnt = xlClipboardFormatText Then
            Range("A1").PasteSpecial (xlPasteAll)
        End If
    Next
End Sub

Upvotes: 2

Related Questions