引用外部文件时将绝对目录转换为相对路径

时间:2016-04-18 17:42:42

标签: ms-access access-vba relative-path ms-access-2016

我正在设计一个包含许多图像的数据库,因此我决定通过存储路径并将图像控件绑定到该字段来链接到外部文件。这是允许我选择文件并将其存储为字符串的代码:

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

然后由控制按钮调用:

Private Sub Command128_Click()
Dim strChoice As String

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

这存储了所选文件的绝对目录,但是我最近意识到我需要存储相对路径,这样当数据库及其相关目录移动到新计算机上时(很可能会发生)这些链接将会保持。

更新:Hans Up提供的实用技巧使我能够实现这一目标。这是我修改和整理的代码。

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

1 个答案:

答案 0 :(得分:0)

这是一个立即窗口会话,演示了可用于确定所选文件的相对路径的技术......

' 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