I need copy a file from server to another server using asp.net/VB.NET for example:
'We copy the original file to the Temp dir
If File.Exists(sFileSource) Then
File.Copy(sFileSource, sFileDest, True)
Else
'The file doesn't exist
End If
But when validate if file exists get that the file doesn't exist, I saw another forum that is a problem of network credentials because the paths are way //192.168.1.10/TemFile/file01.txt.
I have the answer, using a system dll alow connect to oter servers by NetBios
<DllImport("advapi32.DLL", SetLastError:=True)> _
Public Shared Function LogonUser(ByVal lpszUsername As String, ByVal lpszDomain As String, _
ByVal lpszPassword As String, ByVal dwLogonType As Integer, ByVal dwLogonProvider As Integer, _
ByRef phToken As IntPtr) As Integer
End Function
Private _adminToken As IntPtr
Private _widCurrent As WindowsIdentity
Private _widAdmin As WindowsIdentity
Private _wic As WindowsImpersonationContext
Private _admin As AdminShared.AdminManager
If LogonUser(sUser, sDomain, sPassword, 9, 0, _adminToken) <> 0 Then
_widAdmin = New WindowsIdentity(_adminToken)
_wic = _widAdmin.Impersonate()
File.Copy(sFileSource, sFileDest)
Else
Related
I would like to set the volume of an specified process that is playing audio.
I found that I can do it with the waveOutSetVolume WinAPI function because it works as per-process, however, after I read these docs below I still can't figure out how to do it.
waveOutSetVolume function - MSDN
waveOutSetVolume function - pinvoke.net
I'm searching for a solution in C# or VB.Net.
This is the firm of my waveOutSetVolume:
<DllImport("winmm.dll", EntryPoint:="waveOutSetVolume", SetLastError:=True)>
Friend Shared Function WaveOutSetVolume(byval hwo As IntPtr,
byval dwVolume As UInteger) As Integer
End Function
And this is how I'm trying to call the function:
Public Sub SetVolume(ByVal hwo As IntPtr, ByVal volume As Integer)
If (volume < 0) OrElse (volume > 100) Then
Throw New ArgumentOutOfRangeException(
paramName:="volume",
message:="A value between 0 and 100 is required.")
Else
Dim valueFromPercent As UShort = CUShort(volume / (100US / UShort.MaxValue))
' Left channel volume
Dim loBytes As Byte() = BitConverter.GetBytes(valueFromPercent)
' Right channel volume
Dim hiBytes As Byte() = BitConverter.GetBytes(valueFromPercent)
Dim dWord As UInteger =
BitConverter.ToUInt32(loBytes.Concat(hiBytes).ToArray, 0)
NativeMethods.WaveOutSetVolume(hwo, dWord)
End If
End Sub
I know that an hwo will not be the same as a process handle, but as I said I can't figure it out how to discover the hwo of a process.
Note my DWORD calculation seems not be the problem because if I pass a Intptr.Zero to the function then it sets the expected volume for the current application.
I am trying to convert Excel file to PDF using interop.excel, while executing ExportAsFixedFormat 'publishing' progress bar displays on the site. Is there any way to hide this? I found this issue for Excel files having size above 300KB.
Code is given below:
//(tried using Application instead of ApplicationClass)
Microsoft.Office.Interop.Excel.ApplicationClass excelApplication = new Microsoft.Office.Interop.Excel.ApplicationClass();
excelApplication.ScreenUpdating = false;
excelApplication.DisplayAlerts = false;
excelApplication.Visible = false;
if (excelWorkbook == null)
{
excelApplication.Quit();
excelApplication = null;
excelWorkbook = null;
return false;
}
var exportSuccessful = true;
try
{
excelApplication.AlertBeforeOverwriting = false;
excelWorkbook.ExportAsFixedFormat(Microsoft.Office.Interop.Excel.XlFixedFormatType.xlTypePDF, outputPath);
}
catch (System.Exception ex)
{
exportSuccessful = false;
}
I can't find any solution. My project is a C# web application.
It took me a few days to figure out, but finally here is a workarround which uses some WinAPI functions to observe windows events. While the hook is active, every new window is compared to whether its class is the same one as the PDF save dialog class. If that's the case, the window gets hidden.
Thanks for solution ideas go to some chinese guys:
http://www.itjie.wang/officebase/516998.html
Usage requirement:
OS (= Operating System) must be Windows because of WinAPI usage.
Warning:
If the "SetWinEventHook" isn't stopped again due to some errors, it is better to restart your system, otherwise you could run into some serious problems with Windows.
Note:
By default, the PDF save dialog doesn't appear regularly. It depends on the time necessary to save the PDF file. If it takes longer the save popup will show up. If it takes shorter the save popup won't show up. Anyway, you don't have to worry about whether the save dialog would appear or not, the code already does this for you.
Instruction:
In your Excel workbook, if you don't already have a module, create a new one (name doesn't matter) & paste following code:
' WINDOWS API FUNCTIONS:
Private Declare Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As Long) As Long
Private Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassname As String, ByVal nMaxCount As Long) As Long
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
' CONSTANT VARIABLES:
Private Const SW_HIDE = 0
Private Const DLG_CLSID = "CMsoProgressBarWindow"
Private Const EVENT_SYSTEM_FOREGROUND = &H3&
Private Const WINEVENT_OUTOFCONTEXT = 0
' GLOBAL VARIABLES:
Dim long_WinEventHook As Long
Public Function StartEventHook() As Long
long_WinEventHook = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
StartEventHook = long_WinEventHook
End Function
Public Sub StopEventHook()
Dim b_unhooked As Boolean
If long_WinEventHook = 0 Then
MsgBox "WinEventHook couldn't be stopped! " & _
"Variable 'long_WinEventHook' is empty! " & _
"Better restart Windows now!"
Exit Sub
End If
b_unhooked = UnhookWinEvent(long_WinEventHook)
If b_unhooked = True Then
Else
MsgBox "WinEventHook couldn't be stopped! " & _
"Variable 'b_unhooked' is false! " & _
"Better restart Windows now!"
End If
End Sub
' CALLBACK FUNC OF "SetWinEventHook" (DEFINE ACTIONS TO RUN ON THE EVENTS):
' http://stackoverflow.com/questions/20486944/detecting-in-vba-when-the-window-containing-an-excel-instance-becomes-active
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
'This function is a callback passed to the win32 api
'We CANNOT throw an error or break. Bad things will happen
On Error Resume Next
Dim l_handle As Long
Dim s_buffer As String
Dim b_visible As Boolean
Dim i_bufferLength As Integer
s_buffer = String$(32, 0)
i_bufferLength = apiGetClassName(hWnd, s_buffer, Len(s_buffer))
If Left(s_buffer, i_bufferLength) = DLG_CLSID Then
b_visible = apiShowWindow(hWnd, SW_HIDE)
WinEventFunc = hWnd
End If
End Function
In your VBA code, when you want to save your excel workbook as PDF, you would call above macros like this:
' ADD WINDOWS EVENT HOOK BEFORE SAVING:
Application.Run XL_WB.Name & "!StartEventHook"
' SAVE EXCEL AS PDF:
' https://msdn.microsoft.com/de-de/library/microsoft.office.tools.excel.worksheetbase.exportasfixedformat.aspx
XL_WB.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\PDF.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' REMOVE WINDOWS EVENT HOOK AFTER SAVING:
Application.Run XL_WB.Name & "!StopEventHook"
In the above VBA code example "XL_WB" is a variable. You have to adjust it to your needs. For example use "ActiveSheet" instead.
From following other websites users also asked for help with that particular problem:
https://social.msdn.microsoft.com/Forums/office/en-US/e6078904-0715-46a2-8937-c38626464425/exportasfixedformat-progress-bar-can-you-hide-it?forum=exceldev
http://www.vbaexpress.com/forum/archive/index.php/t-41431.html
http://www.excelbanter.com/showthread.php?t=446463
...
I have a annoying problem.
I am trying to delete a registry value (no My Namespace) using the RegDeleteKey Value API, but with one modification.
I want the function have an absolute path as parameter.
So something like this:
RegDeleteKeyValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run","myValue")
Atm it looks like this (This one works, but has no absolute path as parameter, like it should be):
Private Enum RegHive
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_CURRENT_CONFIG = &H80000005
End Enum
RegDeleteKeyValue(Reghive.HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Run","Myvalue")
I tried it to modify the function like this, so the parameters will only be the absolute path and the registryvalue.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
DeleteReyKeyValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run", "123")
End Sub
Public Shared Function DeleteReyKeyValue(ByVal Key As String, ByVal valueName As String) As Long
Dim Handle As IntPtr
Dim Hive As String = Split(Key, "\")(0)
Select Case Hive
Case "HKEY_CLASSES_ROOT"
Handle = CType(&H80000000, IntPtr)
Case "HKEY_CURRENT_USER"
Handle = CType(&H80000001, IntPtr)
Case "HKEY_LOCAL_MACHINE"
Handle = CType(&H80000002, IntPtr)
Case "HKEY_USERS"
Handle = CType(&H80000003, IntPtr)
Case "HKEY_CURRENT_CONFIG"
Handle = CType(&H80000005, IntPtr)
End Select
Key = Key.Replace(Hive, String.Empty)
Return RegDeleteKeyValue(Handle, Key, valueName)
End Function
<DllImport("advapi32.dll")> _
Private Shared Function RegDeleteKeyValue(ByVal handle As IntPtr, ByVal keyName As String, ByVal valueName As String) As Long
End Function
When using this, nothing happens, no error, but the Registryvalue gets not deleted? ;O
Why is that?
The question is already answered in stackoverflow
So to delete your value, you should use this code,
string keyName = #"Software\Microsoft\Windows\CurrentVersion\Run";
using (RegistryKey key = Registry.CurrentUser.OpenSubKey(keyName, true))
{
if (key == null)
{
// Key doesn't exist. Do whatever you want to handle
// this case
}
else
{
key.DeleteValue("123");
}
}
This would delete the value from registry. I am not sure why you are adding such complex codes.
Here is a link to msdn : http://social.msdn.microsoft.com/Forums/vstudio/en-US/5b22e94c-37a9-4be5-ad55-3d9229220194/how-to-use-add-read-change-delete-registry-keys-with-vbnet?forum=vbgeneral
It has the codes for VB but still it is nearly the same for c#, you can use a online converter to convert the codes, http://converter.telerik.com/
Thanks for your quick reply.
In that case a friend helped me out, code is now working.
I was only missing a + "\"
This works now:
Public Shared Function DeleteReyKeyValue(ByVal Key As String, ByVal valueName As String) As Long
Dim Handle As IntPtr
Dim Hive As String = Split(Key, "\")(0)
MsgBox("Hive:" & Hive)
Select Case Hive
Case "HKEY_CLASSES_ROOT"
Handle = CType(&H80000000, IntPtr)
Case "HKEY_CURRENT_USER"
Handle = CType(&H80000001, IntPtr)
Case "HKEY_LOCAL_MACHINE"
Handle = CType(&H80000002, IntPtr)
Case "HKEY_USERS"
Handle = CType(&H80000003, IntPtr)
Case "HKEY_CURRENT_CONFIG"
Handle = CType(&H80000005, IntPtr)
End Select
Key = Key.Replace(Hive + "\", String.Empty)
Return RegDeleteKeyValue(Handle, Key, valueName)
End Function
<DllImport("advapi32.dll")> _
Private Shared Function RegDeleteKeyValue(ByVal handle As IntPtr, ByVal keyName As String, ByVal valueName As String) As Long
End Function
Credits: Rajin
This is the complete vb.net source code.
Imports System.Runtime.InteropServices
Imports System.IO
Public Class WebCam
'WEb camera constants'
Const WM_CAP_START = &H400S
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
Const WM_CAP_SEQUENCE = WM_CAP_START + 62
Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23
Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Const SWP_NOMOVE = &H2S
Const SWP_NOSIZE = 1
Const SWP_NOZORDER = &H4S
Const HWND_BOTTOM = 1
'--The capGetDriverDescription function retrieves the version description of the capture driver--'
Declare Function capGetDriverDescriptionA Lib "avicap32.dll" _
(ByVal wDriverIndex As Short, _
ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _
ByVal cbVer As Integer) As Boolean
'--The capCreateCaptureWindow function creates a capture window--'
Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
(ByVal lpszWindowName As String, ByVal dwStyle As Integer, _
ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
ByVal nHeight As Short, ByVal hWnd As Integer, _
ByVal nID As Integer) As Integer
'--This function sends the specified message to a window or windows--'
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, _
<MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer
'--Sets the position of the window relative to the screen buffer--'
Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _
(ByVal hwnd As Integer, _
ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, _
ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
'--This function destroys the specified window--'
Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean
Dim VideoSource As Integer
Dim hWnd As Integer
'__________________________________________________ End of web camera'
'web cam subs'
'--disconnect from video source---'
Private Sub StopPreviewWindow()
SendMessage(hWnd, WM_CAP_DRIVER_DISCONNECT, VideoSource, 0)
DestroyWindow(hWnd)
End Sub
'---list all the various video sources---'
Private Sub ListVideoSources()
lstVideoSources.Items.Clear()
Dim DriverName As String = Space(80)
Dim DriverVersion As String = Space(80)
For i As Integer = 0 To 9
If capGetDriverDescriptionA(i, DriverName, 80, DriverVersion, 80) Then
lstVideoSources.Items.Add(DriverName.Trim)
End If
Next
End Sub
'---save the image---'
Private Sub CaptureImage()
Dim data As IDataObject
Dim bmap As Image
PictureBoxCaptured.Image = bmap
'---copy the image to the clipboard---'
SendMessage(hWnd, WM_CAP_EDIT_COPY, 0, 0)
'---retrieve the image from clipboard and convert it '
' to the bitmap format'
data = Clipboard.GetDataObject()
If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
bmap = _
CType(data.GetData(GetType(System.Drawing.Bitmap)), _
Image)
PictureBoxCaptured.Image = bmap
'StopPreviewWindow()'
End If
End Sub
'---preview the selected video source---'
Private Sub PreviewVideo(ByVal pbCtrl As PictureBox)
hWnd = capCreateCaptureWindowA(VideoSource, WS_VISIBLE Or WS_CHILD, 0, 0, 0, _
0, pbCtrl.Handle.ToInt32, 0)
If SendMessage(hWnd, WM_CAP_DRIVER_CONNECT, VideoSource, 0) Then
'---set the preview scale---'
SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0)
'---set the preview rate (ms)---'
SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0)
'---start previewing the image---'
SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0)
'---resize window to fit in PictureBox control---'
SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, _
pbCtrl.Width, pbCtrl.Height, _
SWP_NOMOVE Or SWP_NOZORDER)
Else
'--error connecting to video source---'
DestroyWindow(hWnd)
End If
End Sub
Private Sub ButtonWebCamCapture_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonWebCamCapture.Click
CaptureImage()
End Sub
Private Sub ButtonWebCamView_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonWebCamView.Click
'---stop video in case it is on---'
StopPreviewWindow()
'---check which video source is selected---'
VideoSource = lstVideoSources.SelectedIndex
'---preview the selected video source'
PreviewVideo(PictureBoxLive)
End Sub
Private Sub lstVideoSources_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lstVideoSources.SelectedIndexChanged
'---stop video in case it is on---'
StopPreviewWindow()
'---check which video source is selected---'
VideoSource = lstVideoSources.SelectedIndex
'---preview the selected video source'
PreviewVideo(PictureBoxLive)
End Sub
Private Sub btnClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClear.Click
Try
StopPreviewWindow()
PictureBoxLive.Image = Nothing
PictureBoxCaptured.Image = Nothing
Catch ex As Exception
MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Private Sub FormWebCam_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ListVideoSources()
If (lstVideoSources.Items.Count > 0) Then
lstVideoSources.SelectedIndex = 0
'---stop video in case it is on---'
StopPreviewWindow()
'---check which video source is selected---'
VideoSource = lstVideoSources.SelectedIndex
'---preview the selected video source'
PreviewVideo(PictureBoxLive)
End If
'PictureBoxCaptured.Image.Dispose()'
End Sub
Private Sub ButtonSaveAndExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonSaveAndExit.Click
If (PictureBoxCaptured.Image Is Nothing) Then
If (MessageBox.Show("Image is empty." & vbCrLf & "Do you want to exit ?", "Empty", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.Yes) Then
StopPreviewWindow()
Me.Close()
End If
Else
If (ModuleFunctions.IsFormOpen(Item)) Then
Item.PictureBoxItem.Image = PictureBoxCaptured.Image
ElseIf (ModuleFunctions.IsFormOpen(Customer)) Then
Customer.PictureBoxCaptured.Image = PictureBoxCaptured.Image
ElseIf (ModuleFunctions.IsFormOpen(BillCustomises)) Then
BillCustomises.PictureBoxItem.Image = PictureBoxCaptured.Image
End If
StopPreviewWindow()
Me.Close()
End If
End Sub
Private Sub FormWebCam_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
Me.Dispose()
End Sub
End Class
Above code is working fine with my old vb.net project.
Now I want to convert that project into c#. I couldn't convert only the following function.
I want to convert following vb.net code to c#
'--This function sends the specified message to a window or windows--'
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, _
<MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer
I tried using different converters they gives error
"CONVERSION ERROR: Code could not be converted. Details:
-- line 1 col 9: invalid NonModuleDeclaration
Please check for any errors in the original code and try again. "
And I tried my self to convert it, but I have ended up with this.
//--This function sends the specified message to a window or windows--
[DllImport("user32.dll")]
public static extern Boolean SendMessage(int hwnd, int Msg, int wParam, Object lParam);
But it was not correct.Please help me to solve this issue.
Your C# version should be something like this:
[DllImport("user32.dll", CharSet = CharSet.Auto)]
static extern IntPtr SendMessage(IntPtr hWnd, UInt32 Msg,
IntPtr wParam, IntPtr lParam);
Finally I found the answer with complete list.
Thank you every one.
Click here to view complete code
[DllImport("avicap32.dll")]
protected static extern int capCreateCaptureWindowA([MarshalAs(UnmanagedType.VBByRefStr)] ref string
lpszWindowName,int dwStyle, int x, int y, int nWidth, int nHeight, int hWndParent, int nID);
I am kind of stuck with implementing the important feature which requires data to be cleared from office clipboard the moment it is copied.
The intention is not to share the contents with other office programs e.g. word, powerpoint etc. the scenario is that I have some important content in my excel sheet. Once I make a copy of it, it is soon available on office clipboard. if I keep copying the stuff in excel, it keeps collecting in other office programs. However, the windows clipboard would contain only the recent enter which can be cleared using
System.Windows.Forms.Clipboard.clear():
Is there a way out to clear the office clipboard to?
I googled and found out that there may not be a clear cut solution to the program but getting office clipboard window with the help of FindWindowEx(....) should be possible and then message to can be sent in order to clear the contents. It seems that I am not able to get it this way.
can someone tell if they have experienced the same problem?
This might give you a nudge in the right direction... Taken From: mrexcel.com
Option Explicit
Sub myClr()
'Put this sub inta a Sheet Module, like: Sheet1.
Call ClearOfficeClipboard
End Sub
'Put the code from here down into a Standard Module, like Module1.
Private Declare Function FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias _
"PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_LBUTTONDOWN As Long = &H201&
Private Const WM_LBUTTONUP As Long = &H202&
'creates a long variable out of two words
Private Function MakeLong(ByVal nLoWord As Integer, ByVal nHiWord As Integer) As Long
MakeLong = nHiWord * 65536 + nLoWord
End Function
Sub ClearOfficeClipboard()
Dim hMain&, hExcel2&, hWindow&, hParent&
Static sTask As String
'****Dim hClip As Long************************'changed by Lary
Dim octl, bScreenUpdatingIsOn As Boolean
Static lParameter As Long, bNotFirstVisibleTime As Boolean, hClip As Long, bNotFirstTime As Boolean
If Not (bNotFirstTime) Then
lParameter = MakeLong(120, 18)
sTask = Application.CommandBars("Task Pane").NameLocal
'Handle for XLMAIN
hMain = Application.hwnd
bNotFirstTime = True
End If
With Application.CommandBars("Task Pane")
If Not .Visible Then
'assume have to force the window if it is not visible, since it appears that
' the window class does not remain loaded if you clear a non-visible clipboard
'determine current status of screenupdating so that this sub does not change it
bScreenUpdatingIsOn = Application.ScreenUpdating
If bScreenUpdatingIsOn Then Application.ScreenUpdating = False
Set octl = Application.CommandBars(1).FindControl(ID:=809, recursive:=True)
If Not octl Is Nothing Then octl.Execute
.Visible = False
'return to screenupdating on if that is what it was in the beginning
If bScreenUpdatingIsOn Then Application.ScreenUpdating = True
If hClip = 0 Then
hParent = hMain: hWindow = 0
hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
If hWindow Then
hParent = hWindow: hWindow = 0
hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", vbNullString)
End If
End If
Else
If Not (bNotFirstVisibleTime) Then** 'find hClip if window is visible
Do
hExcel2 = FindWindowEx(hMain, hExcel2, "EXCEL2", vbNullString)
hParent = hExcel2: hWindow = 0
hWindow = FindWindowEx(hParent, hWindow, "MsoCommandBar", sTask)
If hWindow Then
hParent = hWindow: hWindow = 0
hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
If hWindow Then
hParent = hWindow: hWindow = 0
hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", vbNullString)
If hClip > 0 Then
Exit Do
End If
End If
End If
Loop While hExcel2 > 0
bNotFirstVisibleTime = True
End If
End If
End With
If hClip = 0 Then
MsgBox "Cant find Clipboard window"
Exit Sub
End If
Call PostMessage(hClip, WM_LBUTTONDOWN, 0&, lParameter)
Call PostMessage(hClip, WM_LBUTTONUP, 0&, lParameter)
End Sub
The code below has been customized for Excel 2013 in vb.net. Just add a button to your ribbon and code works like a charm.
Private Const WM_LBUTTONDOWN As Long = &H201&
Private Const WM_LBUTTONUP As Long = &H202&
WithEvents oAppWD As Excel.Application
Public oDoc As Excel.Workbook
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Int32)
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Int32, ByVal hWnd2 As Int32, ByVal lpsz1 As String, ByVal lpsz2 As String) As Int32
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Int32
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32
Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Int32) As Int32
Private Sub Button1_Click(sender As Object, e As RibbonControlEventArgs) Handles Button1.Click
Dim hMain As Int32, hWord As Int32, hClip As Int32, hWindow As Int32, hParent As Int32
Dim lParameter As Int32
Dim sTask As String
Dim HWND As Int32
'Open the selected File
oAppWD = Globals.ThisAddIn.Application 'DirectCast(System.Runtime.InteropServices.Marshal.GetActiveObject("Excel.Application"), Excel.Application)
oAppWD.Visible = True
oDoc = oAppWD.ActiveWorkbook
oDoc.Activate()
oDoc.Windows(1).Activate()
Sleep(2000)
' MessageBox.Show("Doing it.....")
HWND = FindWindow("XLMAIN", vbNullString)
' Make Office Clipboard Visible
oAppWD.CommandBars("Office Clipboard").Visible = True
BringWindowToTop(HWND)
' Get the handles of the respective Windows Of the Office
sTask = "Office Clipboard"
hMain = HWND
hWord = FindWindowEx(hMain, 0, "EXCEL2", vbNullString)
hParent = hWord : hWindow = 0
hWindow = FindWindowEx(hParent, 0, "MsoCommandBar", sTask)
If hWindow Then
hParent = hWindow : hWindow = 0
hWindow = FindWindowEx(hParent, 0, "MsoWorkPane", vbNullString)
If hWindow Then
hParent = hWindow : hWindow = 0
hClip = FindWindowEx(hParent, 0, vbNullString, "Collect and Paste 2.0")
End If
End If
If hClip = 0 Then
MsgBox("Cant find Clipboard window")
Exit Sub
End If
' Pass the message 120,18 are the respective co-ordinates of the Clear all button.
lParameter = MakeLong(120, 18)
' Send the Message
Call PostMessage(hClip, WM_LBUTTONDOWN, 0&, lParameter)
Call PostMessage(hClip, WM_LBUTTONUP, 0&, lParameter)
Sleep(100)
End Sub
Private Function MakeLong(ByVal nLoWord As Integer, ByVal nHiWord As Integer) As Int32
MakeLong = nHiWord * 65536 + nLoWord
End Function