VBA, MS Access MS Access в примерах

Открытие файла программой по умолчанию (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
Назад ToTop
L.E. 26.01.2024
Рейтинг@Mail.ru