I want to open cmd.exe in excel 365 vba.
I used to open shell in excel 2013 but it seems not to work in excel 365.
I tried this code and works for calc.exe, ... but not for cmd.exe.
Does it need a special parameter/permission to run from vba.
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
Sub ShellExec()
Dim strFile As String
Dim strAction As String
Dim lngErr As LongPtr
' Edit this:
strFile = "notepad.exe" ' the file you want to open/etc.
strAction = "OPEN" ' action might be OPEN, NEW or other, depending on what you need to do
lngErr = ShellExecute(0, strAction, strFile, "", "", 0)
' optionally, add code to test lngErr
End Sub
Kind regards,
w.
use SW_SHOW = 5 as last parameter
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
Sub ShellExec()
Dim strFile As String
Dim strAction As String
Dim lngErr As LongPtr
' Edit this:
strFile = "cmd.exe" ' the file you want to open/etc.
strAction = "OPEN" ' action might be OPEN, NEW or other, depending on what you need to do
lngErr = ShellExecute(0, strAction, strFile, "", "", 5)
' optionally, add code to test lngErr
End Sub
Related
I am trying to download an excel file stored in sharepoint (no unc path available) to my desktop.
This code below seems to work and create "CST.xlsx" but I get an error msg:
Notes:
Url for excel file is taken directly from the web address bar and everthing after ".xlsx" is removed.
Code:
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
Function DownloadFileFromWeb(strURL As String, strSavePath As String) As Long
' strSavePath includes filename
DownloadFileFromWeb = URLDownloadToFile(0, strURL, strSavePath, 0, 0)
End Function
Sub download()
Call DownloadFileFromWeb("url.xlsx", "Desktop\download\CST.xlsx")
End Sub
See my answer in this thread about the same problem for a workaround.
I have a process that requires an active VPN connection, but the connection is automatically cut every 8 hours. I need to be able to control that the connection is active and the time left up to the 8 hour limit.
In the properties of the windows connections the time appears (attached capture with the data that I need), but I need to know how to read this data.
Try the next approach, please:
Edited, because of the last request:
Please add two new declarations
Copy the next API functions on top of a standard module:
Option Explicit
Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private 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 LongPtr
Private Declare PtrSafe Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As LongPtr, _
ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
Private Declare PtrSafe Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, _
ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "User32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long
And the next Constant:
Private Const GW_HWNDNEXT = 2
'Added after editing:__________________
Private Const WM_LBUTTON_DOWN = &H201
Private Const BM_CLICK = &HF5
'______________________________________
In the same standard module, copy the next Sub. Please, take care to change Duration: from the code, with the Spanish correct variant ('Duración' [with the necessary accent]):
Sub DurationAPI()
Dim hwndEth As LongPtr, hwndGen As LongPtr, hwndDurlbl As LongPtr, hwndDur As LongPtr
Dim sStr As String, strWindowTitle As String, durationLbl As String, durT As Date, limitD As Date
'added after editing:_____________________________
OpenWiFiConnectionWindow 'open connection window
AppActivate Application.ActiveWindow.Caption
'_________________________________________________
limitD = CDate("08:00:00")
strWindowTitle = "Estado de Wi-Fi"
durationLbl = "Duration:" 'Please change here with your exact label title (in Spanish...)
'I cannot write duracion: with the necessary accent...
hwndEth = FindWindow(vbNullString, strWindowTitle): Debug.Print Hex(hwndEth)
hwndGen = FindWindowEx(hwndEth, 0&, vbNullString, "General"): Debug.Print Hex(hwndGen)
hwndDurlbl = FindWindowEx(hwndGen, 0&, vbNullString, durationLbl): Debug.Print Hex(hwndDurlbl)
hwndDur = GetWindow(hwndDurlbl, GW_HWNDNEXT): Debug.Print Hex(hwndDur)
sStr = String(GetWindowTextLength(hwndDur) + 1, Chr$(0))
GetWindowText hwndDur, sStr, Len(sStr)
durT = CDate(sStr)
MsgBox Format(limitD - durT, "hh:mm:ss") & " left until connection will be interrupted!", _
vbInformation, "Time to connection interruption"
'Added after editing: ____________________________________________________
Dim hwndClose As LongPtr
'closing the connection window:
hwndClose = FindWindowEx(hwndEth, 0&, vbNullString, "&Close"): Debug.Print Hex(hwndClose)
SendMessage hwndClose, WM_LBUTTON_DOWN, 0&, 0&
SendMessage hwndClose, BM_CLICK, 0, ByVal 0&
'_________________________________________________________________________
End Sub
bis Copy the Sub able to show the necessary connection window:
Private Sub OpenWiFiConnectionWindow()
Dim objApp As Object: Set objApp = CreateObject("Shell.Application")
Dim objFolder As Object: Set objFolder = objApp.Namespace(&H31&).self.GetFolder
Dim interface As Variant, interfaceTarget As Object, InterfaceName As String
InterfaceName = "Wi-Fi" 'Please, check here what is show your "Network Connections" folder. It maybe can be slightly different...
'I tested the code on my Ethernet connection, which not was simple "Ethernet". It was "Ethernet 2"...
For Each interface In objFolder.Items
If LCase(interface.Name) = LCase(InterfaceName) Then
Set interfaceTarget = interface: Exit For
End If
Next
Dim Verb As Variant
For Each Verb In interfaceTarget.Verbs
If Verb.Name = "Stat&us" Then
Verb.DoIt
Application.Wait Now + TimeValue("0:00:01")
Exit For
End If
Next
End Sub
Please, try this Sub first, in order to be sure that it shows the necessary connection window. If it doesn't, please look in the "Network Connections" folder and change InterfaceName with an appropriate one.
Run the above DurationAPI() Sub.
All the necessary windows handlers are returned in Immediate window. If one of them is 0 (zero), there must be checked to understand what is happening... I used Spy++ to find the windows titles/classes...
For a window with English titles, it returns correctly and almost instant the necessary connection duration time.
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.
I have this link:
https://s23527.pcdn.co/wp-content/uploads/2017/04/wine_speedlights_kit_lens.jpg.optimal.jpg
It is on Cell A2:
I want to get on Cell B2 the dimensions of the URL of this JPG
(I don't mind how to get it, it can be 1920 on cell B2 and 1080 on cell C2)
You will need to make an API call to URLDownloadToFile to download your image. In the below example, we will download to the temp folder C:\Temp\.
Once your image is downloaded, you will create a new Shell object, and ultimately use the .ExtendedProperty() property to grab your file dimensions
After you have finished downloading your file, you can go ahead and delete the temporary file using Kill().
The below method uses Early Binding. You will need to set a reference to
Microsoft Shell Controls And Automation
By going to Tools -> References in the VBE menu
Option Explicit
#If VBA7 Then
Declare PtrSafe 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
#Else
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 test()
Const tmpDir$ = "C:\Temp\"
Const tmpFile$ = "tmpPicFile.jpg"
Debug.Print URLDownloadToFile(0, ActiveSheet.Range("A2").Value, tmpDir & tmpFile, 0, 0)
ActiveSheet.Range("B2").Value = getFileDimensions(tmpDir, tmpFile)
Kill tmpDir & tmpFile
End Sub
Private Function getFileDimensions(filePath$, fileName$) As String
With New Shell32.Shell
With .Namespace(filePath).ParseName(fileName)
getFileDimensions = .ExtendedProperty("Dimensions")
End With
End With
End Function
I’ve got following Excel scenario:
A1 has the value of "A", B2 = "B", C3 = "C"
but they are interchangeable.
Within the workbook path there are two subfolders containing wav files named A.wav, B.wav and C.wav
The code at the bottom allows me to playback the wav files with a button click firing the macro PlayIt().
My Problem is, while the function is executing I’m unable to edit cells in Excel which I really need to! It kinda looks like this
https://gifyu.com/images/GIF8d5e1.gif
Thank you for any help!
Code for Audioplayback:
Option Explicit
#If VBA7 Then
Public Declare PtrSafe Function PlaySound Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
#Else
Public Declare Function PlaySound Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
#End If
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
Sub PlayTheSound(ByVal WhatSound As String)
If Dir(WhatSound, vbNormal) = "" Then
' WhatSound is not a file. Get the file named by
' WhatSound from the Windows\Media directory.
WhatSound = ThisWorkbook.Path & "\stimuli\" & "\1second\" & WhatSound
If InStr(1, WhatSound, ".") = 0 Then
' if WhatSound does not have a .wav extension,
' add one.
WhatSound = WhatSound & ".wav"
End If
If Dir(WhatSound, vbNormal) = vbNullString Then
Beep ' Can't find the file. Do a simple Beep.
MsgBox "Could not find the file in the Path: " & WhatSound
Exit Sub
End If
Else
' WhatSound is a file. Use it.
End If
PlaySound WhatSound, 0&, SND_ASYNC Or SND_FILENAME ' Finally, play the sound.
End Sub
Sub PlayIt()
PlayTheSound (Range("A1").Value)
PlayTheSound (Range("B1").Value)
PlayTheSound (Range("C1").Value & "e")
End Sub
You have your declaration wrong in two ways: hModule should be LongPtr, and you are using parameters from PlaySound while actually calling sndPlaySound.
Fix your declaration:
#If VBA7 Then
Public Declare PtrSafe Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As LongPtr, ByVal dwFlags As Long) As Long
#Else
Public Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
#End If