how copy text from vba to windows clipbaord - vba

I have an ms access vba code from which i wish to copy some text value to the Windows clipboard so that I can paste it elsewhere (Word/Excel/Notepad/etc).
I have been searching for this in SO but everything seems over-complicated.
Should it not be something simple like
clipboard.SetText textValue
?
EDIT
I tried following the hint by BrianMStafford but don't succeed. Perhaps the reason is that my object is a node in a tree.
When I do
MsgBox Me.NodeKey.Value
it all works fine - I see the node path in the message box.
But when I do
Me.NodeKey.SetFocus
DoCmd.RunCommand acCmdCopy
I don't get the node path in the clipboard
So how can I copy the node path value into the Windows clipboard?

It should be as simple as you say, however Access for some reason doesn't have the same "options" as excel. You have to add it manually or use Cristian Buse's answer which is pretty much the same, he is skipping adding the reference. So here is the way to manually add the reference to use .SetText in Access.
Access does not have the MS Forms listed on the Reference table like Excel (dont ask me why), but you can Browse to the file location and add it manually:
After you add this manually you can use the .SetText anywhere as long as you also declare the object of course.
Sub testCopy()
Dim clipOb As MSForms.DataObject
Set clipOb = New MSForms.DataObject
clipOb.SetText Format(Now(), "m/d/yyyy")
clipOb.PutInClipboard
End Sub
Now you can paste it anywhere. Just replace Format(Now(), "m/d/yyyy") with your Me.NodeKey.Value. If your Value is empty/blank it will give you an error, so just do a check before using .SetText to make sure you have a value to set.

Use Windows API to Set Clipboard Data.
Here's the documentation page:
https://learn.microsoft.com/en-us/office/vba/access/concepts/windows-api/send-information-to-the-clipboard
Here's the code required with 2 example of how to use.
After running sub to save data to clipboard, just paste it anywhere.
Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd 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 SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Public Sub SetClipboard(sUniText As String)
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Const GMEM_MOVEABLE As Long = &H2
Const GMEM_ZEROINIT As Long = &H40
Const CF_UNICODETEXT As Long = &HD
OpenClipboard 0&
EmptyClipboard
iLen = LenB(sUniText) + 2&
iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
iLock = GlobalLock(iStrPtr)
lstrcpy iLock, StrPtr(sUniText)
GlobalUnlock iStrPtr
SetClipboardData CF_UNICODETEXT, iStrPtr
CloseClipboard
End Sub
Sub Example_SetClipboardData_1()
SetClipboard "Hello World"
End Sub
Sub Example_SetClipboardData_2()
Dim TextVar As String
TextVar = "Hello again, World"
SetClipboard TextVar
End Sub

Public Sub WriteToClipboard(ByVal text As String)
CreateObject("htmlfile").ParentWindow.ClipboardData.SetData "text", text
End Sub
Example usage:
WriteToClipboard "test"
Edit #1
The above seems to work in Excel just fine. I only managed to make it work in Access for a specific computer. Once tested on another computer I got an error 70 (access denied).
The below only works in Excel if Windows Explorer is closed. However, it seems to work fine in Access regardless if Explorer is open/closed:
Public Sub WriteToClipboard(ByVal text As String)
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 'MsForms.DataObject
.SetText text
.PutInClipboard
End With
End Sub

When googling the object code that Cristian posted, I found a good page listing the possibilities, both early and late binding. Hence this page combines the answers by Christian Buse and Ricardo A.
See
https://desmondoshiwambo.wordpress.com/2012/02/23/how-to-copy-and-paste-text-tofrom-clipboard-using-vba-microsoft-access/

Related

Is it possible to pass arguments to the Application_Startup sub in outlook?

I have a macro in outlook which I want to run on startup sometimes... Odd request I know. I know about the Application_Startup Sub but I am wondering if it is possible to pass command-line arguments to it?
EDIT: our real requirement is to sometimes run a macro on startup based on a command-line argument. I have tried VBS and Application.Run and also the command-line switch /autorun which has been deprecated as of outlook 2003.
You can use the GetCommandLine function which retrieves the command-line string for the current process. To access the function just paste this API declaration at the top of your macro module:
Declare Function GetCommandLineA Lib "Kernel32" () As String
And then in the VBA sub you can use the following code:
Dim cmdLineArgs As String
'Get the commande line string
cmdLineArgs = GetCommandLineA
found this : https://social.msdn.microsoft.com/Forums/en-US/0017d844-3e4a-4115-bc51-cf02ca23db0c/vba-to-fetch-excel-command-line-64-bit?forum=exceldev
posted by : https://social.msdn.microsoft.com/profile/andreas%20killer/?ws=usercard-mini
'Note: Declaration is overloaded with LONG!
#If Win64 Then
Private Declare PtrSafe Function GetCommandLineL Lib "kernel32" Alias "GetCommandLineA" () As LongPtr
Private Declare PtrSafe Function lstrcpyL Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As LongPtr) As Long
Private Declare PtrSafe Function lstrlenL Lib "kernel32" Alias "lstrlenA" (ByVal lpString As LongPtr) As Long
#Else
Private Declare Function GetCommandLineL Lib "kernel32" Alias "GetCommandLineA" () As Long
Private Declare Function lstrcpyL Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlenL Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
#End If
'
Function GetCommandLine() As String
#If Win64 Then
Dim lngPtr As LongPtr
#Else
Dim lngPtr As Long
#End If
Dim strReturn As String
Dim StringLength As Long
lngPtr = GetCommandLineL ' Get the pointer to the commandline string
StringLength = lstrlenL(lngPtr) ' get the length of the string (not including the terminating null character):
strReturn = String$(StringLength + 1, 0) ' initialize our string so it has enough characters including the null character:
lstrcpyL strReturn, lngPtr ' copy the string we have a pointer to into our new string:
GetCommandLine = Left$(strReturn, StringLength) ' now strip off the null character at the end:
End Function
Sub getCmdLine()
Debug.Print GetCommandLine()
End Sub

Turning NUMLOCK on at the end of a macro run

What code does: I have a code that moves the mouse around the screen, takes printscreens and pastes it to excel.
Problem: For some reason, my code always (with absolutely no exceptions) turns the NUMLOCK key off after every run.
What I tried so far: I searched around and found the SendKeys (NUMLOCK), which in theory works (although it seems to be very problematic for users).
What I want to do: I want to turn the NUMLOCK on after each macro run,
Obs1: I have no idea what is causing the macro to turn it off in the first place. Fixing whatever is causing this would be ideal, but since I have no idea what the problem is, I first want to get my code functional. I am going to work on that as soon as find a way to turn the NUMLOCK key on.
Question: Can I do this using the SendKeys? Am I using it properly? Is there a better way?
Obs2: Since it is a much bigger code, as soon as this is solved, I am going to post another question with the entire code, and go over on what is causing the problem.
Code I am trying to sue to turn numlock on:
Application.Sendkeys (NUMLOCK)
Also tried:
Application.Sendkeys ("NUMLOCK")
and
Application.Sendkeys {NUMLOCK}
You can set the keystate directly with a couple of Windows API calls. Ported from the MSDN page for keybd_event function:
#If VBA7 Then
Private Declare PtrSafe Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As LongPtr, ByVal dwExtraInfo As LongPtr)
Private Declare PtrSafe Function GetKeyboardState Lib "user32.dll" (ByVal lpKeyState As LongPtr) As Boolean
#Else
Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "user32.dll" (ByVal lpKeyState As Long) As Boolean
#End If
Private Const KEYEVENTF_EXTENDEDKEY As Long = &H1
Private Const KEYEVENTF_KEYUP As Long = &H2
Private Const VK_NUMLOCK As Byte = &H90
Private Const NumLockScanCode As Byte = &H45
Private Sub ToggleNumlock(enabled As Boolean)
Dim keystate(255) As Byte
'Test current keyboard state.
GetKeyboardState (VarPtr(keystate(0)))
If (Not keystate(VK_NUMLOCK) And enabled) Or (keystate(VK_NUMLOCK) And Not enabled) Then
'Send a keydown
keybd_event VK_NUMLOCK, NumLockScanCode, KEYEVENTF_EXTENDEDKEY, 0&
'Send a keyup
keybd_event VK_NUMLOCK, NumLockScanCode, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0&
End If
End Sub
Call it like this:
Sub Example()
'Turn Numlock off.
ToggleNumlock False
'Turn Numlock on.
ToggleNumlock True
End Sub
First of all, Copy and paste the following code in your Excel Sheet’s Module (Ex:-Module-1)...
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const kCapital = 20
Private Const kNumlock = 144
Public Function CapsLock() As Boolean
CapsLock = KeyState(kCapital)
End Function
Public Function NumLock() As Boolean
NumLock = KeyState(kNumlock)
End Function
Private Function KeyState(lKey As Long) As Boolean
KeyState = CBool(GetKeyState(lKey))
End Function
Then, Copy and Paste the following in your Sheet's Code (Ex:- Sheet1 (Code))...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("XFD1").FormulaR1C1 = "=NumLock()"
If Range("XFD1").Value = "FALSE" Then
SendKeys "{NUMLOCK}"
Else
End If
End Sub
Now Chill!!! For Each SelectionChange you make, Excel Refreshes itself and It makes sure that Numlock is On Always.
Replace "Capslock" instead of Numlock if you need it so as the case may be.
Thanks. Sashi Elit :)
I found this solution so far the best and does not interfere with NUMLOCK.
Put below code in a module and call it from anywhere in your project. The script object overwrites the SendKeys in VBA.
Public Sub Sendkeys(text as variant, Optional wait As Boolean = False)
Dim WshShell As Object
Set WshShell = CreateObject("wscript.shell")
WshShell.Sendkeys cstr(text), wait
Set WshShell = Nothing
End Sub
I found it in below thread:
SendKeys() permission denied error in Visual Basic
I tried all the suggestions until I noticed that it's not (NUMLOCK) but {NUMLOCK}. This worked for me.
Sub Numlock()
SendKeys "{NUMLOCK}"
End Sub
You almost had it!
The correct coding is:
Application.Sendkeys ("{NUMLOCK}")

GetWindow API VB

I usually write scripts in the VBE of Excel because they all tend to involve Excel. This time I wrote a script which has nothing to do with Excel, so I want to make it an executable file.
Note:
- Below code is a part of the actual script
- I tested this part also separately in the VBE and it works
- I tried it now in Visual Studio 2015
Problem:
- The code returns the handle of lWindow, but always returns 0 voor lChild
Module Module1
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String,
ByVal lpWindowName As String) As Long
Declare Function GetWindow Lib "user32.dll" (
ByVal hwnd As Long,
ByVal wCmd As Long) As Long
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const BM_CLICK = &HF5&
Sub Main()
Dim lWindow As Long
Dim lChild As Long
lWindow = FindWindow(vbNullString, "Untitled - Notepad")
Debug.Print(lWindow)
lChild = GetWindow(lWindow, GW_CHILD)
Debug.Print(lChild)
End Sub
End Module
Thanks.

How to make a resizable UserFrom?

I do not know how to make the simplest in the world resizable UserForm. What I have seen on different forum threads are terrible behemots (huge as the Universe libraries doing too much). But I need a simple, one stroke solution and I hope it exists. At this moment I have this code:
Dim myForm As UserForm1
Set myForm = New UserForm1
myForm.Caption = "Attributes"
myForm.Show
And I have UserForm_Initialize() which does some extra work. What is horrible (unreasonable?) is that by default a form is not resizable.
Here's a simple guide on how to make a userform drag and re-sizable.
http://www.mrexcel.com/forum/excel-questions/558649-userform-movable-resizable.html
Here is transcribed solution from
https://www.mrexcel.com/board/threads/resize-a-userform.485489/
I have tested it and it works
First add these declaration to your header
'Declaration for form resize
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Add this sub to your form
Private Sub MakeFormResizable()
'Written: August 02, 2010
'Author: Leith Ross
'Summary: Makes the UserForm resizable by dragging one of the sides. Place a call
' to the macro MakeFormResizable in the UserForm'
'from https://www.mrexcel.com/board/threads/resize-a-userform.485489/
Dim lStyle As Long
Dim hWnd As Long
Dim RetVal
Const WS_THICKFRAME = &H40000
Const GWL_STYLE As Long = (-16)
hWnd = GetActiveWindow
'Get the basic window style
lStyle = GetWindowLong(hWnd, GWL_STYLE) Or WS_THICKFRAME
'Set the basic window styles
RetVal = SetWindowLong(hWnd, GWL_STYLE, lStyle)
'Clear any previous API error codes
SetLastError 0
'Did the style change?
If RetVal = 0 Then MsgBox "Unable to make UserForm Resizable."
End Sub
And finally call this sub from your Userform_Activate
Private Sub UserForm_Activate()
MakeFormResizable
End Sub

VBA to Prevent Keyboard Input While a Package Object (XML) is Read into ADODB Stream?

I am developing an application which opens and reads an XML document previously embedded in a PowerPoint presentation, or a Word document. In order to read this object (xmlFile as Object) I have to do:
xmlFile.OLEFormat.DoVerb 1
This opens the package object, and I have another subroutine that gets the open instance of Notepad.exe, and reads its contents in to ADODB stream.
An example of this procedure is available on Google Docs:
XML_Test.pptm.
During this process there is a few seconds window where the Notepad.exe gains focus, and an inadvertent keystroke may cause undesired results or error reading the XML data.
I am looking for one of two things:
Either a method to prevent the user from inadvertently inputting (via keyboard/mouse/etc) while this operation is being performed. Preferably something that does not take control of the user's machine like MouseKeyboardTest subroutine, below. Or,
A better method of extracting the XML data into a string variable.
For #1: this is the function that I found, which I am leery of using. I am wary of taking this sort of control of the users system. ##Are there any other methods that I might use?##
Private Declare Function BlockInput Lib "USER32.dll" (ByVal fBlockIt As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub MouseKeyboardTest() 'both keyboard and mouse blocked
BlockInput True ' Turns off Keyboard and Mouse
' Routine goes here
Sleep 5000 ' Optional coding
BlockInput False ' Turns on Keyboard and Mouse
End Sub
For #2: Some background, but the issue seems to be the inability to extract the embedded object reliably using any method other than DoVerb 1. Since I am dealing with an unsaved document in an application (Notepad) that is immune to my VBA skillz, this seems to be the only way to do this. Full background on that, here:
Extracting an OLEObject (XML Document) from PowerPoint VBA
As you correctly guessed in the comment above that taking the focus away from notepad will solve your problem. The below code does exactly that.
LOGIC:
A. Loop through the shape and get it's name. In your scenario it would be something like Chart Meta XML_fbc9775a-19ea-.txt
B. Use APIs like FindWindow, GetWindowTextLength, GetWindow etc to get the handle of the notepad window using partial caption.
C. Use the ShowWindow API to minimize the window
Code (tested in VBA-Powerpoint)
Paste this code in a module in the above PPTM
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "User32" Alias _
"GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long
Private Const GW_HWNDNEXT = 2
Private Const SW_SHOWMINIMIZED = 2
Sub Sample()
Dim shp As Shape
Dim winName As String
Dim Ret As Long
For Each shp In ActivePresentation.Slides(1).Shapes
If shp.Type = msoEmbeddedOLEObject Then
winName = shp.Name
shp.OLEFormat.Activate
Exit For
End If
Next
If winName <> "" Then
Wait 1
If GetHwndFromCaption(Ret, Replace(winName, ".txt", "")) = True Then
Call ShowWindow(Ret, SW_SHOWMINIMIZED)
Else
MsgBox "Window not found!", vbOKOnly + vbExclamation
End If
End If
End Sub
Private Function GetHwndFromCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean
Dim Ret As Long
Dim sStr As String
GetHwndFromCaption = False
Ret = FindWindow(vbNullString, vbNullString)
Do While Ret <> 0
sStr = String(GetWindowTextLength(Ret) + 1, Chr$(0))
GetWindowText Ret, sStr, Len(sStr)
sStr = Left$(sStr, Len(sStr) - 1)
If InStr(1, sStr, sCaption) > 0 Then
GetHwndFromCaption = True
lWnd = Ret
Exit Do
End If
Ret = GetWindow(Ret, GW_HWNDNEXT)
Loop
End Function
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
My understanding is that you have control over how XML file gets embedded into PowerPoint presentation in the first place. Here I do not quite understand why you chose to keep the data you need as contents of an embedded object.
To be sure, the task of getting those contents back is not a piece of cake. Actually, as long as there is no (simple or even moderately difficult) way to call QueryInterface and use IPersist* interfaces from VBA, there is just one way to get to contents of embedded object. The way involves following steps:
Activate an embedded object. You used OLEFormat.DoVerb 1 for that. A better way would be to call OLEFormat.Activate, but this is irrelevant for your particular problem.
Use embedded object's programming model to perform useful operations like getting contents, saving or whatever is exposed. Notepad.exe exposes no such programming model, and you resorted to WinAPI which is the best choice available.
Unfortunately, your current approach has at least 2 flaws:
The one you identified in the question (activation of notepad.exe leading to possibility of user's interference).
If a user has default program for opening .txt files other than notepad.exe, your approach is doomed.
If you do have control over how embedded object is created then better approach would be to store your XML data in some property of Shape object. I would use Shape.AlternativeText (very straightforward to use; shouldn't be used if you export your .pptm to HTML or have some different scenario where AlternativeText matters) or Shape.Tags (this one is probably the most semantically correct for the task) for that.
I don't think that blocking the user is the right approach,
If you must use a content of a notepad window, I would suggest using the SendKeys method, in order to send this combination:
SendKeys("^A^C")
Which is the equivalent of "Select All" and "Copy",
And then you could continue working "offline" on the clipboard, without fear of interference by keystrokes.
My approach, per Sid's suggestion, was to find a way to minimize the Notepad.exe. Since I already found way to get that object and close it, I figured this should not be as hard.
I add these:
Public Declare Function _
ShowWindow& Lib "user32" (ByVal hwnd As Long, _
ByVal ncmdshow As Long)
Public Const SW_MINIMIZE = 6
And then, in the FindNotepad function, right before Exit Function (so, after the Notepad has been found) I minimize the window with:
ShowWindow TopWnd, SW_MINIMIZE