' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Const cstrExecutable As String = "C:\Program Files (x86)\Audacity\audacity.exe"
Private Const cstrPath As String = "C:\Daten\1_Spiegelungen\"
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strFile As String, strPath As String, strExec As String, strTmp As String
Dim strTempFile As String, strExtension As String
If Target.Column = 7 Then 'Spaltennummer anpassen!
If Target.Value = "Play" Then
Cancel = True
strTmp = Cells(Target.Row, 6).Text
strPath = Mid(strTmp, 1, InStrRev(strTmp, ".") - 1) & "\"
strExtension = Mid(strTmp, InStrRev(strTmp, "."))
strTempFile = Environ("TEMP") & "\tmp" & strExtension
strExec = GetShortName(cstrExecutable)
strFile = GetShortName(cstrPath & strPath & strTmp)
If Dir(strTempFile, vbNormal) <> "" Then Kill strTempFile
Call FileCopy(strFile, strTempFile)
Call ShellExecute(0, "open", strExec, strTempFile, vbNullString, 1)
End If
End If
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
#If VBA7 Then
Public 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
Public 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
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal _
lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Function GetShortName(ByVal sLongFileName As String) As String
Dim lRetVal As Long, sShortPathName As String, iLen As Integer
'Set up buffer area for API function call return
sShortPathName = Space(255)
iLen = Len(sShortPathName)
'Call the function
lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
'Strip away unwanted characters.
GetShortName = Left(sShortPathName, lRetVal)
End Function
