VBA Tipp: Kurzen Dateinamen ermitteln

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Es soll ermittelt werden, welcher kurze Dateiname (in der 16-bit-Windows 8.3-Notation) einem langen Dateinamen in Windows entspricht.

Lösung 1

Das geht mit folgender Funktion, die in einem allgemeinen (globalen) Modul gespeichert wird.

Public Function GetShortPathName(LongPath As String) As String
 
   ' Verwendet Late Binding. Deshalb ist kein Verweis auf "Microsoft Scriping Runtime" notwendig.
   ' Quelle: http://www.dbwiki.net/
 
   On Error Resume Next
 
   GetShortPathName = CreateObject("Scripting.FileSystemObject") _
      .GetFile(LongPath).ShortPath
 
End Function

Lösung 2

Das geht mit folgener API-Deklaration und VBA-Funktion, die in einem allgemeinen (globalen) Modul gespeichert werden.

#If VBA7 Then
Private Declare PtrSafe Function GetShortPathNameW Lib "kernel32" ( _
   ByVal lpszLongPath As LongPtr, _
   ByVal lpszShortPath As LongPtr, _
   ByVal cchBuffer As Long) As Long
#Else
Private Declare Function GetShortPathNameW Lib "kernel32" ( _
   ByVal lpszLongPath As Long, _
   ByVal lpszShortPath As Long, _
   ByVal cchBuffer As Long) As Long
#End If
 
Public Function GetShortPathName(LongPath As String) As String
 
   ' Quelle: http://www.dbwiki.net/
 
   Dim result As Long
   Dim buf As String
 
   buf = String$(512, vbNullChar)
   result = GetShortPathNameW(StrPtr(LongPath), StrPtr(buf), Len(buf))
   If result Then
      GetShortPathName = Mid$(buf, 1, result)
   End If
 
End Function

Aufruf

Die Funktion kann man dann z.B. so verwenden, und den Rückgabewert im Direktfenster anzeigen lassen.

   Dim MyPath As String
 
   MyPath = GetShortPathName("C:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE")
 
   Debug.Print MyPath
   ' ergibt dann z.B.: C:\PROGRA~2\MICROS~1\Office14\MSACCESS.EXE

Weblinks