Resolving shortcuts

[quekett]

The problem
We are about to carry out a data migration which limits our Pathnames+filename to 200 characters.
In order to maintain our data structure we intend to move folders that exceed the limit to a "Long Folders" directory leaving a shortcut behind at the original position.
The data will then be transfered to a read only server with an unknown drive specification. Hence we want to create the shortcuts with relative as well as absolute path references.
The other major problem is that I can only use standard library call as the system is locked down. Hence I cannot just import library files.

Where I have got to
The code below creates a shortcut with a relative path and absolute path correctly.
If the shortcut is activated before it is made read only, the path is resolved and once made read only and moved still works using the relative link information
As the number of these shorcuts could run into 1000's I need to automate this process
I have found a resolve method in the shell class and by using a library supplied at http://www.pacificdb.com.au/MVP/Download/SHELLLNK.TLB
I can use some fairly cumbersome code to call function but it appears to work. However, I cannot use it on a live system as it using a non standard library.

However, I am sure I can call it somehow from shell32.dll. Any suggestions or alternatives welcome

Operating system NT, Access 97


Public Enum STGM
STGM_DIRECT = &H0&
STGM_TRANSACTED = &H10000
STGM_SIMPLE = &H8000000
STGM_READ = &H0&
STGM_WRITE = &H1&
STGM_READWRITE = &H2&
STGM_SHARE_DENY_NONE = &H40&
STGM_SHARE_DENY_READ = &H30&
STGM_SHARE_DENY_WRITE = &H20&
STGM_SHARE_EXCLUSIVE = &H10&
STGM_PRIORITY = &H40000
STGM_DELETEONRELEASE = &H4000000
STGM_CREATE = &H1000&
STGM_CONVERT = &H20000
STGM_FAILIFTHERE = &H0&
STGM_NOSCRATCH = &H100000
End Enum

Public Sub testCreateDesktopShortcut()

Dim oShell As IWshShell_Class
Dim oShortcut As IWshShortcut_Class
Dim cShellLink As ShellLinkA
Dim cPersistFile As IPersistFile
Dim SShortcutName As String
Dim Fso As New FileSystemObject
Dim MyFile As File
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")


Set oShell = New IWshShell_Class

Set oShortcut = oShell.CreateShortcut("R:\ecawbcapcoord\Personal\Test Level 1\Test Level 2\Test Level 3\Test Level 4.lnk")
oShortcut.TargetPath = "R:\ecawbcapcoord\Personal\Test Level 1"
oShortcut.RelativePath = "..\..\Test Level 1"
oShortcut.WorkingDirectory = "."
oShortcut.Save
SShortcutName = oShortcut.FullName

'Resolve Shortcut
Set cShellLink = New ShellLinkA 'Create new IShellLink interface
Set cPersistFile = cShellLink 'Implement cShellLink's IPersistFile interface
cPersistFile.Load StrConv(SShortcutName, vbUnicode), STGM_DIRECT
Set cShellLink = cPersistFile
cShellLink.Resolve 0, SLR_UPDATE
Set cPersistFile = cShellLink
cPersistFile.Save StrConv(SShortcutName, vbUnicode), 0

Set MyFile = Fso.GetFile("R:\ecawbcapcoord\Personal\Test Level 1\Test Level 2\Test Level 3\Test Level 4.lnk")
MyFile.Attributes = 1

Set MyFile = Nothing
Set oShortcut = Nothing
Set oShell = Nothing
Set Fso = Nothing
Set cShellLink = Nothing
Set cPersistFile = Nothing

End Sub