Problem solve Get help with specific problems with your technologies, process and projects.

Find That Long Pathname

This tip allows Visual Basic programmers to find a full pathname given the file name.

Find That Long Pathname

File names can be a bear, especially when you need to know a full file name or path, and all you have is the file specification in the old style 8.3 format. Reader David Goben offers this tip, which allows you to find a full pathname given the file name.

A lot has been said about the GetShortPathname() API call, but I have not seen anything regarding obtaining the long path name, which is something we require at my company. So I'm submitting the following module code which will support this. It takes advantage of the GetLongPathName() API available to Win98/Me/2000, but this code will also support NT4.0/Win95 if this API is not available:

Option Explicit
'Return the longpath of a shortpath specification
' modGetLongPath - The GetLongPath() function returns the longpath version 
of a
'                  filepath or dirpath that is formatted in the 8.3 
'                  format.
'  Debug.Print GetLongPath("C:Progra~1Common~1micros~1webser~1")
''' This will print:
''' C:Program FilesCommon FilesMicrosoft SharedWeb Server Extensions
'NOTE: This module requires a reference to Microsoft Scripting Runtime 

Private Declare Function GetLongPathName Lib "kernel32" Alias 
"GetLongPathNameA" _
       (ByVal lpszLongPath As String, _
        ByVal lpszLongPath As String, _
        ByVal cchBuffer As Long) As Long
Public Function GetLongPath(InPath As String) As String
  Dim fso As FileSystemObject, fold As Folder, fil As File
  Dim S As String, I As Integer, j As Integer, drv As String, tmp As String
  Dim SS As String
  S = Trim$(InPath)                                 'get the trimmed form 
of path
  drv = String(260, 0)                              'receiving buffer
  On Error Resume Next
  I = GetLongPathName(S, drv, 260)                  'get buffer to drv, len 
to I
  If Err.Number = 0 Then                            'not win98/ME/2000
    GetLongPath = Left$(drv, I)                     'return path if no 
    Exit Function
  End If
  On Error GoTo 0
' win Nt4.0/95 or below, so do it with an FSO
  drv = ""                                          'blank in case not 
  If Len(Dir(S)) Or Len(Dir(S, vbDirectory)) Then   'file/dir exists
    drv = S                                         'init to full path
' check for short stuff existing
    If InStr(1, S, "~") Then                        'short stuff in there?
      drv = ""                                      'yes, so yank sort path
      Set fso = New FileSystemObject                'set up pathing object
      If Left$(S, 2) = "" Then                    'UNC path?
        I = InStr(3, S, "")                        'yes, skip device name
        If I Then
          j = InStr(I + 1, S, "")                  'then skip drive name
          If j Then I = j
        End If
        I = InStr(3, S, "")                        'else just skip drive
      End If
      If I Then                                     'drivepath specified?
        drv = Left$(S, I)                           'get drive
        S = Mid$(S, I + 1)                          'get stuff after
      End If
' step through directory data
      I = InStr(I + 1, S, "")                      'a subdir path?
      Do While I
        tmp = LCase$(Left$(S, I - 1))               'yes, get subdir name
        j = InStr(tmp, "~")                         'short name?
        If j Then                                   'yes, find full name
          SS = Dir(drv & Left$(tmp, j - 1) & "*", vbDirectory)
          Do While Len(SS)
            Set fold = fso.GetFolder(drv & SS)      'get folder for long 
            If LCase$(fold.ShortName) = tmp Then Exit Do  'found short 
            SS = Dir()                              'else get next
          SS = tmp                                  'not short, so keep 
full name
        End If
        drv = drv & SS & ""                        'set new base path
        S = Mid$(S, I + 1)                          'trimp off prev dir
        I = InStr(1, S, "")                        'check for another
' handle stuff left over
      If Len(S) Then
        j = InStr(1, S, "~")                        'last item short?
        If j Then                                   'yes
          SS = Dir(drv & Left$(S, j - 1) & "*", vbDirectory)
          If Len(SS) Then                           'was a directory
            Do While Len(SS)                        'get full path
              Set fold = fso.GetFolder(drv & SS)
              If LCase$(fold.ShortName) = S Then Exit Do
              SS = Dir()                            'never blank unless 
it's a file
          End If
          If Len(SS) = 0 Then                       'file?
            SS = Dir(drv & Left$(S, j - 1) & "*")   'yes, check matching 
            Do While Len(SS)
              Set fil = fso.GetFile(drv & SS)       'check for matching 
              If LCase$(fil.ShortName) = S Then Exit Do
              SS = Dir()                            'else check next
          End If
          SS = S                                    'keep full name if noth 
        End If
      End If
      If Len(SS) Then drv = drv & SS                'build full long path
      Set fso = Nothing                             'remove object
    End If
  End If
  GetLongPath = drv                                 'return result
End Function

Thanks, David. As a token of our appreciation, we will be sending you a SearchVB denim shirt.

David Goben is lead developer for Merry Mechanization, Inc.'s Advanced Development Group. He have been programming since 1978, first in Assembler, then Fortran, C, Forth, Pascal, and finally BASIC. He has used VB since Version 1.0.

Dig Deeper on Win Development Resources

Join the conversation

1 comment

Send me notifications when other members comment.

Please create a username to comment.

You can use long path tool, it works good.