Conversion de répertoires absolus en chemins relatifs en référence à des fichiers externes

Question

Je suis en train de concevoir une base de données incorporant de nombreuses images. J'ai donc décidé de lier des fichiers externes en stockant leurs chemins et en limitant un contrôle d'image à ce champ. Voici le code qui me permet de sélectionner le fichier et le stocker était une chaîne:

Public Function ShowFileDialog() As String 
Dim objFD As Object 
Dim strOut As String 

strOut = vbNullString 
Set objFD = Application.FileDialog(msoFileDialogOpen) 
If objFD.Show = -1 Then 
    strOut = objFD.SelectedItems(1) 
End If 
Set objFD = Nothing 
ShowFileDialog = strOut 
End Function 

qui est ensuite appelé par un bouton de commande:

Private Sub Command128_Click() 
Dim strChoice As String 

strChoice = ShowFileDialog 
If Len(strChoice) > 0 Then 
    Me.Path = strChoice 
Else 
    'bleh 
End If 
End Sub 

Ce stocke le répertoire absolu du Fichier sélectionné, mais j'ai récemment réalisé que je devais stocker des chemins relatifs afin que lorsque la base de données et ses répertoires associés sont déplacés sur un nouvel ordinateur (ce qui est très probable), ces liens seront conservés.

---

MISE À JOUR: Les conseils utiles fournies par Hans Up m'a permis d'obtenir ce travail. Voici mon code révisé et rangé.

Public Function GetPath() 

Dim objFD As Object 
Dim strOut As String 
Dim strAbsolute As String 
Dim strFolder As String 
Dim strRelativePath As String 

strOut = vbNullString 

Set objFD = Application.FileDialog(msoFileDialogOpen) 
If objFD.Show = -1 Then 
    strOut = objFD.SelectedItems(1) 
End If 

Set objFD = Nothing 
strAbsolute = strOut 

strFolder = CurrentProject.Path & "\" 
strRelativePath = Mid(strAbsolute, Len(strFolder) + 1) 

If Len(strRelativePath) > 0 Then 
    Me.Path = strRelativePath 
Else 
    'bleh 
End If 

End Function 

Private Sub Command128_Click() 
GetPath 

End Sub 

Answer 1

Voici une session de fenêtre immédiate qui démontre des techniques que vous pouvez utiliser pour déterminer le chemin relatif de votre fichier sélectionné ...

' folder where db file resides ... 
? CurrentProject.Path 
C:\share\Access 

strFolder = CurrentProject.Path & Chr(92) 
? strFolder 
C:\share\Access\ 

' strChoice is the file path from your code sample; 
' use Mid() to get the piece from that string which follows strFolder ... 
strChoice = "C:\share\Access\image\foo.png" 
strRelativePath = Mid(strChoice, Len(strFolder) + 1) 
? strRelativePath 
image\foo.png 

' combine base folder and relative path again just to confirm we got the right pieces ... 
? strFolder & strRelativePath 
C:\share\Access\image\foo.png