How to Retrieve the Path for Linked OLE Objects

[motleyjew]

I am trying to get the file path from a linked ole object in my database. I am using code microsofts website. Here is the link to the article. I have listed the code below.
http://support.microsoft.com/kb/199066

I am able to get the code to work, however I am having a problem when a folder or file name is over 8 characters. When a file is over 8 characters it inserts a "~1" after the file name. Here is a example:

Actual File Name
\\FOLDER\Public\Asset Managment\6-10-08.XLS

String generated after function is ran
\\FOLDER\Public\ASSETM~1\6-10-0~1.XLS

Any help would be appreciated.

Gregg

Function GetLinkedPath(objOLE As Variant) As Variant
   Dim strChunk As String
   Dim pathStart As Long
   Dim pathEnd As Long
   Dim path As String
   If Not IsNull(objOLE) Then
      ' Convert string to Unicode.
      strChunk = StrConv(objOLE, vbUnicode)
      pathStart = InStr(1, strChunk, ":\", 1) - 1

      ' If mapped drive path not found, try UNC path.
      If pathStart <= 0 Then pathStart = _
                       InStr(1, strChunk, "\\", 1)

      ' If either drive letter path or UNC path found, determine
      ' the length of the path by searching for the first null
      ' character Chr(0) after the path was found.
      If pathStart > 0 Then
         pathEnd = InStr(pathStart, strChunk, Chr(0), 1)
         path = Mid(strChunk, pathStart, pathEnd - pathStart)
         GetLinkedPath = path
         Exit Function
      End If
   Else
      GetLinkedPath = Null
   End If
End Function

 

[pono1]

The article says the "procedure may not work in some circumstances..." and "storing the path in a separate Text field when you link the OLE object is the best way to ensure that you will be able to retrieve the path later." Will that not work for you?

If not, you could probably come up with some logic to determine if you have what you want from the code that is in the article and if there's a tilde in the folder name, attempt to figure out the full folder name through some brute force coding...

* very rough pseudo code *

If path has a ~ Then
   FigureOutPath(pathRoot, lastfolderalias)
Else
   Path is OK
End if

Function FigureOutPath (pathRoot as String, lastfolderalias as String) as string
' You will probably want to use the FileSystemObject here...

  Dim MyFolderNames as Collection
  For each folder in pathroot.folders
    If left(folder.name,8) = lastfolderalias Then
       ' We may have found it...so save the full name 
        MyFolderNames.add folder.name
    End if
   Next 

   If myFolderNames.count = 1 Then
   ' One name match? Then this is probably it.
      FigureOutPath = MyFolderNames.name
   Else
      FigureOutPath = Null
   End if

End Function

Regards,
Tim