Konvertieren von absoluten Verzeichnissen in relative Pfade beim Verweisen auf externe Dateien

Question

Ich entwerfe eine Datenbank, die viele Bilder enthält, also habe ich beschlossen, zu externen Dateien zu verknüpfen, indem ich ihre Pfade speichere und ein Bildsteuerelement an dieses Feld anschließe. Hier ist der Code, der mir die Datei auswählen und speichern es eine Zeichenfolge war:

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 

, die dann durch eine Steuertaste aufgerufen wird:

Private Sub Command128_Click() 
Dim strChoice As String 

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

Dieser speichert die absolute Verzeichnis der ausgewählte Datei, aber ich habe vor kurzem festgestellt, dass ich relative Pfade speichern muss, so dass diese Links beibehalten werden, wenn die Datenbank und die zugehörigen Verzeichnisse auf einen neuen Computer verschoben werden (was sehr wahrscheinlich passieren wird).

---

UPDATE: Die hilfreichen Tipps von Hans Up versehen konnte ich diese Arbeit bekommen. Hier ist mein überarbeiteter und aufgeräumter Code.

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

Hier ist eine Direkt-Fenster-Sitzung, die Techniken zeigen Sie den relativen Pfad der ausgewählten Datei verwenden können ...

' 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