VBA Tipp: Langen Dateinamen aus kurzem Dateinamen ermitteln

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte ermitteln, welche langen Dateinamen den kurzen Dateinamen (in der 16-bit-Windows 8.3-Notation) entsprechen.

Lösung 1

Public Function GetLongPathName(ShortPath As String) As String
 
   ' Quelle: http://www.dbwiki.net/
 
   Dim sLongName  As String
   Dim sTemp      As String
   Dim iSlashPos  As Integer
 
   ' Add \ to short name to prevent InStr from failing
   ShortPath = ShortPath & "\"
 
   ' Start from 4 to ignore the "[Drive Letter]:\" characters
   iSlashPos = InStr(4, ShortPath, "\")
 
   ' Pull out each string between \ character for conversion
   Do While iSlashPos
     sTemp = Dir$(Left$(ShortPath, iSlashPos - 1), _
                vbNormal Or vbHidden Or vbSystem Or vbDirectory)
     If sTemp = vbNullString Then
        'Error 52: Dateiname oder -nummer falsch
        Exit Function
     End If
     sLongName = sLongName & "\" & sTemp
     iSlashPos = InStr(iSlashPos + 1, ShortPath, "\")
   Loop
 
   ' Prefix with the drive letter
   GetLongPathName = Left$(ShortPath, 2) & sLongName
 
End Function

Lösung 2

#If VBA7 Then
Private Declare PtrSafe Function GetLongPathNameW Lib "kernel32" ( _
   ByVal lpszShortPath As LongPtr, _
   ByVal lpszLongPath As LongPtr, _
   ByVal cchBuffer As Long) As Long
#Else  'VBA5 (für Office Versionen <= 2007)
Private Declare Function GetLongPathNameW Lib "kernel32" ( _
   ByVal lpszShortPath As Long, _
   ByVal lpszLongPath As Long, _
   ByVal cchBuffer As Long) As Long
#End If
 
Public Function GetLongPathName(ShortPath As String) As String
 
   ' Quelle: http://www.dbwiki.net/
 
   Dim result As Long
   Dim buf As String
 
   buf = String$(32768, vbNullChar)
   result = GetLongPathNameW(StrPtr(ShortPath), StrPtr(buf), Len(buf))
   If result Then
      GetLongPathName = Mid$(buf, 1, result)
   End If
 
End Function

Aufruf

im Direktfenster:

 Debug.Print GetLongPathName("C:\PROGRA~1") ' ergibt: C:\Program Files

Weblinks