Открытие файла программой по умолчанию (API x86+x64)По материалам: https://www.cyberforum.ru/ms-access/thread3151914.html#post17193886 ' -------------------------------------------------------------------------------------------------/ ' Name: modShellExecute ' Kind: Module ' Purpose: Открытие файла программой по умолчанию (API x86+x64) ' Author: es ' Date: 26.01.2024 ' -------------------------------------------------------------------------------------------------/ #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 LongPtr) As LongPtr 'WindowStyle constants (not all): Private Const SW_HIDE As LongPtr = 0 Private Const SW_NORMAL As LongPtr = 1 Private Const SW_MAXIMIZE As LongPtr = 3 Private Const SW_MINIMIZE As LongPtr = 6 #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 'WindowStyle constants (not all): Private Const SW_HIDE As Long = 0 Private Const SW_NORMAL As Long = 1 Private Const SW_MAXIMIZE As Long = 3 Private Const SW_MINIMIZE As Long = 6 #End If 'ShellExecute Error value constants (not all): ' Private Const ERROR_SUCCESS = 32& ' Private Const ERROR_NO_ASSOC = 31& ' Private Const ERROR_OUT_OF_MEM = 0& ' Private Const ERROR_FILE_NOT_FOUND = 2& ' Private Const ERROR_PATH_NOT_FOUND = 3& ' Private Const ERROR_BAD_FORMAT = 11& Public Function OpenFileWithDefaultProgram(strFilePath As String) #If VBA7 Then Dim lResult As LongPtr #Else Dim lResult As Long #End If lResult = ShellExecute(Application.hWndAccessApp, "open", strFilePath, 0, 0, SW_NORMAL) 'Debug.Print lResult 'Разбор "полётов": Select Case lResult Case 2, 3 'ERROR_FILE_NOT_FOUND + ERROR_PATH_NOT_FOUND MsgBox "Файл: " & strFilePath & " - не найден!", vbExclamation, "ShellExecute" Case 31 'There is no application associated with the given file-name extension. 'Shows the "Open With" dialog allowing the user to select what program to use Shell "rundll32.exe shell32.dll,OpenAs_RunDLL " & strFilePath, vbNormalFocus End Select End Function
Private Sub APIFunction_Demo() 'Пример эксплуотации ShellExecute в оболочке OpenFileWithDefaultProgram:
OpenFileWithDefaultProgram "d:\Temp\Тест01.txt"
End Sub
|
|||
L.E. 26.01.2024 |