Open URL on Windows and a 64-bit Mac - excel

The following code opens a URL on Windows machines (Excel 2016, 2013, 2010).
I'm trying to make it usable on a 64-bit Mac (Excel for Mac v. 16.22, Office 365 install) as well.
I have tried a number of iterations for finding the Mac library "libc.dylib", and usually get the "Runtime Error '53'. File not found 'libc.dylib'" error. Once I got the error "Runtime Error '453'. File not found '/usr/lib/libc.dylib'".
Here's the code that produced the 453 error:
Option Explicit
Enum W32_Window_State
Show_Normal = 1
Show_Minimized = 2
Show_Maximized = 3
Show_Min_No_Active = 7
Show_Default = 10
End Enum
#If Mac Then
#If VBA7 Then
Private Declare PtrSafe Function system Lib "/usr/lib/libc.dylib" (ByVal command As String) As LongPtr
#Else
Private Declare Function system Lib "/usr/lib/libc.dylib" (ByVal command As String) As Long
#End If
#Else
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As LongPtr, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As LongPtr
#Else
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
#End If
#End If
Public Function OpenURL(URL As String, WindowState As W32_Window_State) As Boolean
'Opens passed URL with default application, or Error Code (<32) upon error
#If VBA7 Then
Dim lngHWnd As LongPtr
Dim lngReturn As LongPtr
#Else
Dim lngHWnd As Long
Dim lngReturn As Long
#End If
#If Mac Then
lngReturn = system("open -a Safari --args " & URL)
#Else
lngReturn = ShellExecute(lngHWnd, "open", URL, vbNullString, _
vbNullString, WindowState)
#End If
OpenURL = (lngReturn > 32) ' With Mac, this may return a dummy variable, but we're going to do it anyways.
End Function
In addition to the code here, I have tried using colons in the file path in place of the slashes. That gave me an error of '53, file not found' as well.

Related

VBA to open Onscreen keyboard in 64bit Excel

I am trying to open the osk.exe from VBA within Excel 64 bit on Windows 10 64 bit.
I have pieced together the following code that works for 32bit Excel on 64bit Windows 10, but I don't know how to modify it to get it working again with 64bit Excel:
Option Explicit
Type SHELLEXECUTEINFO
cbSize As LongPtr
fMask As Long
hwnd As LongPtr
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As LongPtr
hProcess As Long
End Type
Public Declare PtrSafe Function ShellExecuteEx Lib "shell32.dll" _
(lpExecInfo As SHELLEXECUTEINFO) As LongPtr
Declare PtrSafe Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" (ByRef ptr As LongPtr) As Boolean
Declare PtrSafe Function Wow64RevertWow64FsRedirection Lib "kernel32.dll" (ByRef ptr As LongPtr) As Boolean
Public Function KeyboardOpen()
Dim shInfo As SHELLEXECUTEINFO
Dim lngPtr As LongPtr
With shInfo
.cbSize = Len(shInfo)
.lpFile = "C:\Windows\Sysnative\cmd.exe" 'best to use Known folders here
.lpParameters = "/c start osk.exe"
.lpDirectory = "C:\windows\system32" 'best to use Known folders here
.lpVerb = "open"
.nShow = 0
End With
Call Wow64DisableWow64FsRedirection(lngPtr)
Call ShellExecuteEx(shInfo)
Call Wow64RevertWow64FsRedirection(lngPtr)
End Function
Sub OpenKeyboard()
Call KeyboardOpen
End Sub
I have found a solution. To get the 64bit Windows 10 On screen keyboard (osk.exe) to run, add the following code to a module to a 64bit Excel, then you can call OpenKeyboardSub from within your application:
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub OpenKeyboardSub()
ShellExecute 0, vbNullString, "osk.exe", vbNullString, "C:\", 1
End Sub

Cannot change excel icon in taskbar with vba

I am using the following code to change word icon in windows taskbar from the usual word icon to an icon I have made.
But it doesn't work...only changes the small icon on the top-left corner of the application or userform.(not the taskbar)
I tried solution on the web including this link(
how to change the Excel Icon in Taskbar while loading,
Cannot change excel icon (in taskbar) with vba) and searched on stackoverflow.com but it couldn't help.
I am using Windows 10 & word 2010(I also tried this code on excel but it was same.)
I hope someone can help....
#If VBA7 And Win64 Then
Private Declare PtrSafe Function ExtractIconA Lib "shell32.dll" _
(ByVal hInst As LongPtr, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As LongPtr
Private Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Declare PtrSafe Function GetActiveWindow32 Lib "user32" Alias "GetActiveWindow" () As Long
Private Const ICON_SMALL As LongPtr = 0&
Private Const ICON_BIG As LongPtr = 1&
Dim hwndIcon As LongPtr
#Else
Declare Function GetActiveWindow32 Lib "user32" Alias "GetActiveWindow" () As Integer
Declare Function SendMessage32 Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function ExtractIcon32 Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Const ICON_SMALL As Long = 0&
Private Const ICON_BIG As Long = 1&
Dim hwndIcon As Long
#End If
Private Const WM_SETICON As Long = &H80
Public Sub ChangeApplicationIcon()
bigIcon_Path = ThisDocument.path & "\DataDontTouch\Icon\32X32B32.ico"
smallIcon_Path = ThisDocument.path & "\DataDontTouch\Icon\16X16B32.ico"
bigIcon = ExtractIconA(0, bigIcon_Path, 0)
smallIcon = ExtractIconA(0, smallIcon_Path, 0)
SendMessageA GetActiveWindow32(), &H80, 0&, smallIcon
SendMessageA GetActiveWindow32(), &H80, 1&, bigIcon
ActiveWindow.Caption = "Fast.exe"
End Sub

Troubled with VBA version difference: version 6 and version 7

I'm new to VBA and use excel 2010 64bit VBA v6.0 compatible. I pasted the code, trying to download files through VBA.
Option Explicit
'Tutorial link: https://youtu.be/H4-w6ULc_qs
#If VBA7 Then
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
Sub download_file()
'-----------------------------
'Thanks for downloading the code.
'Please visit our channel for a quick explainer on how to use this code.
'Feel free to update the code as per your need and also share with your friends.
'Download free codes from http://vbaa2z.blogspot.com
'Support our channel: youtube.com/vbaa2z
'Author: L Pamai (vbaa2z.team#gmail.com)
'-----------------------------
Dim downloadStatus As Variant
Dim url As String
Dim destinationFile_local As String
url = [D3]
destinationFile_local = "C:\Users\myUserName\Downloads\" & fileName([D3])
downloadStatus = URLDownloadToFile(0, url, destinationFile_local, 0, 0)
If downloadStatus = 0 Then
MsgBox "Downloaded Succcessfully!"
Else
MsgBox "Download failed"
End If
End Sub
Function fileName(file_fullname) As String
fileName = Mid(file_fullname, InStrRev(file_fullname, "/") + 1)
End Function
However, a pop-up window says it can only run on 64-bit systems as follow:
Compile error:
The code in this project must be updated for use on 64-bit systems. Please review and update Declare statements and then mark them with the PtrSafe attribute.
My questions are:
I do use window and office 64-bit system. Why the window keeps popping up?
Is there any way to solve this problem?
Thanks in advance.
As the error tells you, add the PtrSafe keyword to the VBA7 branch
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
You need to add this keyword anywhere you are using LongPtr, or LongLong.
Here is the MS Documentation on PtrSafe
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/ptrsafe-keyword
Adding the PtrSafe keyword to a Declare statement only signifies that the Declare statement explicitly targets 64-bits. All data types within the statement that need to store 64-bits (including return values and parameters) must still be modified to hold 64-bit quantities by using either LongLong for 64-bit integrals or LongPtr for pointers and handles.

minimize window driver selenium excel vba

I have searched a lot for a way to minimize the window of the driver in selenium for excel vba. I have found ways for Java and python and tried to adopt them but all my tries failed
I just found a way to maximize the window using
bot.Window.Maximize
But when trying to use Minimize I got an error
Again I am searching for excel vba as for selenium ...
Thanks advanced for help
AFAIK there is no method for this in VBA implementation (there is in Python for example). There are a number of ways to manipulate size and position e.g.
bot.Window.SetSize 0, 0
Or you can run headless
bot.AddArgument "--headless"
You might also try to:
1) Emulate Windows Key + Down
2) Write a javscript function that performs window.minimize() and async execute off the parent window
3) Capture your target co-ordinates by generating a GetWindowPlacement call along with implementing your own WINDOWPLACEMENT struct. Looks like gets ugly fast.
See also:
Getting the size of a minimized window
Driver.Window.SetSize 0, 0
just made the window smaller, without minimizing the browser to the taskbar.
How to use GetWindowPlacement in selenium vba?
'for vb6
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Sub Command1_Click()
Dim wp As WINDOWPLACEMENT
wp.Length = Len(wp)
GetWindowPlacement targetHandle, wp
End Sub
Minimize window by windows API
This is a workaround for Selenium VBA not having a working minimize window option.
''compiler constants
#If VBA7 Then
Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Boolean
Public Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
#Else
Public Declare Function ShowWindow Lib "USER32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Boolean
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
#End If
Dim hwnd As Long
Dim Botwindowtitle As String
bot.Start
Botwindowtitle = bot.Window.Title
hwnd = GetAllWindowHandles(Botwindowtitle)
Call ShowWindow(hwnd, 7) 'Show the window minimized (SW_SHOWMINNOACTIVE = 7) http://www.jasinskionline.com/windowsapi/ref/s/showwindow.html
bot.Get "https://www.google.com/"
Private Function GetAllWindowHandles(partialName As String) As Long
Dim hwnd As Long, lngRet As Long
Dim strText As String
Dim hWndTemp As Long
hwnd = FindWindowEx(0&, 0&, vbNullString, vbNullString)
Do While hwnd <> 0
strText = String$(100, Chr$(0))
lngRet = GetWindowText(hwnd, strText, 100)
If InStr(1, strText, partialName, vbTextCompare) > 0 Then
Debug.Print "Window Handle:" & hwnd & vbNewLine & _
"Window title:" & Left$(strText, lngRet) & vbNewLine & _
"----------------------"
hWndTemp = hwnd
GetAllWindowHandles = hWndTemp
End If
'~~> Find next window
hwnd = FindWindowEx(0&, hwnd, vbNullString, vbNullString)
Loop
End Function

Close folder opened through Explorer.exe

It's a bit of a silly question, but how do you close a folder through Excel VBA ? Below the code to opening it,
Shell "Explorer.exe \\sharepoint.com#SSL\DavWWWRoot\sites\folder", vbMinimizedFocus
This solution with the process ID unfortunately does not work.
The following code loops through all opened Explorer windows. So you can use that to match against the LocationURL and get the window handle hWnd and use Windows API SendMessage to close the window.
Option Explicit
'for 64-bit Excel use
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
'for 32-bit Excel use
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060
Public Sub CloseWindowExample()
Dim sh As Object
Set sh = CreateObject("shell.application")
Dim w As Variant
For Each w In sh.Windows
'print all locations in the intermediate window
Debug.Print w.LocationURL
' select correct shell window by LocationURL
If w.LocationURL = "file://sharepoint.com#SSL/DavWWWRoot/sites/folder" Then
SendMessage w.hWnd, WM_SYSCOMMAND, SC_CLOSE, 0
End If
Next w
End Sub
Note that the LocationURL path begins with file:// and that all backslashes \ in the path are converted to slashes / as shown in the example.
To make it compatible with both 64 and 32 bit Excel you can use
#If VBA7 Then
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
#Else
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
#End If
Note that one of these will be marked in red as compile error but the code will still run.

Resources