Получение абсолютного пути изображения

Question

Я хочу получить абсолютный путь к папке изображений с именем изображения (например, \ image1.jpg) в конце пути, где ImagePath - это имя поля пути изображения в таблице. Я просто не уверен, как правильно его форматировать.

Как мне это сделать?

Вот что я уже пробовал:

=IIf(IsNull([ImagePath]),Null,GetPath() & "C:\Criminal Records Database\Persons_Images\" & [ImagePath]) 

Answer 1

GetUNCPath способ перевести любой путь в универсальной Именование пути Конвенции, через сетевые диски. Он вернет локальный диск как абсолютный путь, если не подключен к сети. Я использую эту функцию, чтобы гарантировать, что у меня есть полный абсолютный путь.

Я написал код ниже (с некоторой помощью от @GSerg), чтобы упростить преобразование пути в полный абсолютный путь UNC.

Использование

Dim fullPath as string 
fullPath = GetUNCPath("T:\SomeDir\SomeFile.Txt") 

Он преобразует T: \ SomeDir \ Somefile.txt в \\ SomeServer \ SomeShare \ SomeDir \ Somefile.txt

Это было проверено на Access 2003 и Access 2010. Это 32-разрядная и 64-разрядная совместимость.

Модуль: GetUNC

Option Compare Database 
Option Explicit 

#If VBA7 Then 
    Private Declare PtrSafe Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionW" (ByVal lpLocalName As LongPtr, ByVal lpRemoteName As Long, lpnLength As Long) As Long 
    Private Declare PtrSafe Function PathIsUNC Lib "shlwapi.dll" Alias "PathIsUNCW" (ByVal pszPath As LongPtr) As Long 
    Private Declare PtrSafe Function PathIsNetworkPath Lib "shlwapi.dll" Alias "PathIsNetworkPathW" (ByVal pszPath As LongPtr) As Long 
    Private Declare PtrSafe Function PathStripToRoot Lib "shlwapi.dll" Alias "PathStripToRootW" (ByVal pPath As LongPtr) As LongPtr 
    Private Declare PtrSafe Function PathSkipRoot Lib "shlwapi.dll" Alias "PathSkipRootW" (ByVal pPath As LongPtr) As Long 
    Private Declare PtrSafe Function PathRemoveBackslash Lib "shlwapi.dll" Alias "PathRemoveBackslashW" (ByVal strPath As LongPtr) As LongPtr 
#Else 
    Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionW" (ByVal lpLocalName As Long, ByVal lpRemoteName As Long, lpnLength As Long) As Long 
    Private Declare Function PathIsUNC Lib "shlwapi.dll" Alias "PathIsUNCW" (ByVal pszPath As Long) As Long 
    Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" Alias "PathIsNetworkPathW" (ByVal pszPath As Long) As Long 
    Private Declare Function PathStripToRoot Lib "shlwapi.dll" Alias "PathStripToRootW" (ByVal pPath As Long) As Long 
    Private Declare Function PathSkipRoot Lib "shlwapi.dll" Alias "PathSkipRootW" (ByVal pPath As Long) As Long 
    Private Declare Function PathRemoveBackslash Lib "shlwapi.dll" Alias "PathRemoveBackslashW" (ByVal strPath As Long) As Long 
#End If 

Public Function GetUNCPath(sLocalPath As String) As String 
    Dim lResult As Long 
#If VBA7 Then 
    Dim lpResult As LongPtr 
#Else 
    Dim lpResult As Long 
#End If 
    Dim ASLocal As APIString 
    Dim ASPath As APIString 
    Dim ASRoot As APIString 
    Dim ASRemoteRoot As APIString 
    Dim ASTemp As APIString 

    Set ASLocal = New APIString 
    ASLocal.Value = sLocalPath 

    If ASLocal.Pointer > 0 Then 
    lResult = PathIsUNC(ASLocal.Pointer) 
    End If 
    If lResult <> 0 Then 
    GetUNCPath = ASLocal.Value 
    Exit Function 
    End If 

    If ASLocal.Pointer > 0 Then 
    lResult = PathIsNetworkPath(ASLocal.Pointer) 
    End If 
    If lResult = 0 Then 
    GetUNCPath = ASLocal.Value 
    Exit Function 
    End If 

    ' Extract Root 
    Set ASRoot = New APIString 
    ASRoot.Value = sLocalPath 
    If ASRoot.Length = 2 And Mid(ASRoot.Value, 2, 1) = ":" Then 
    ' We have a Root with no Path 
    Set ASPath = New APIString 
    ASPath.Value = "" 
    Else 
    If ASRoot.Pointer > 0 Then 
     lpResult = PathStripToRoot(ASRoot.Pointer) 
    End If 
    ASRoot.TruncToNull 
    If ASRoot.Pointer > 0 And Mid(ASRoot.Value, ASRoot.Length) = "\" Then 
     lpResult = PathRemoveBackslash(ASRoot.Pointer) 
     ASRoot.TruncToPointer lpResult 
    End If 

    ' Extract Path 
    Set ASPath = New APIString 
    ASPath.Value = sLocalPath 
    lpResult = PathSkipRoot(ASPath.Pointer) 
    ASPath.TruncFromPointer lpResult 
    If ASPath.Length > 0 Then 
     If ASPath.Pointer > 0 And Mid(ASPath.Value, ASPath.Length) = "\" Then 
     lpResult = PathRemoveBackslash(ASPath.Pointer) 
     ASPath.TruncToPointer lpResult 
     End If 
    End If 
    End If 

    ' Resolve Local Root into Remote Root 
    Set ASRemoteRoot = New APIString 
    ASRemoteRoot.Init 255 
    If ASRoot.Pointer > 0 And ASRemoteRoot.Pointer > 0 Then 
    lResult = WNetGetConnection(ASRoot.Pointer, ASRemoteRoot.Pointer, LenB(ASRemoteRoot.Value)) 
    End If 
    ASRemoteRoot.TruncToNull 

    GetUNCPath = ASRemoteRoot.Value & ASPath.Value 
End Function 

Класс модуля: APIString

Option Compare Database 
Option Explicit 

Private sBuffer As String 

Private Sub Class_Initialize() 
    sBuffer = vbNullChar 
End Sub 

Private Sub Class_Terminate() 
    sBuffer = "" 
End Sub 

Public Property Get Value() As String 
    Value = sBuffer 
End Property 

Public Property Let Value(ByVal sNewStr As String) 
    sBuffer = sNewStr 
End Property 

' Truncates Length 
#If VBA7 Then 
    Public Sub TruncToPointer(ByVal lpNewUBound As LongPtr) 
#Else 
    Public Sub TruncToPointer(ByVal lpNewUBound As Long) 
#End If 
    Dim lpDiff As Long 
    If lpNewUBound <= StrPtr(sBuffer) Then Exit Sub 
    lpDiff = (lpNewUBound - StrPtr(sBuffer)) \ 2 
    sBuffer = Mid(sBuffer, 1, lpDiff) 
End Sub 

' Shifts Starting Point forward 
#If VBA7 Then 
Public Sub TruncFromPointer(ByVal lpNewLBound As LongPtr) 
#Else 
Public Sub TruncFromPointer(ByVal lpNewLBound As Long) 
#End If 
    Dim lDiff As Long 
    If lpNewLBound <= StrPtr(sBuffer) Then Exit Sub 
    If lpNewLBound >= (StrPtr(sBuffer) + LenB(sBuffer)) Then 
    sBuffer = "" 
    Exit Sub 
    End If 
    lDiff = (lpNewLBound - StrPtr(sBuffer)) \ 2 
    sBuffer = Mid(sBuffer, lDiff) 
End Sub 

Public Sub Init(Size As Long) 
    sBuffer = String(Size, vbNullChar) 
End Sub 

Public Sub TruncToNull() 
    Dim lPos As Long 
    lPos = InStr(sBuffer, vbNullChar) 
    If lPos = 0 Then Exit Sub 
    sBuffer = Mid(sBuffer, 1, lPos - 1) 
End Sub 

Public Property Get Length() As Long 
    Length = Len(sBuffer) 
End Property 

#If VBA7 Then 
Public Property Get Pointer() As LongPtr 
#Else 
Public Property Get Pointer() As Long 
#End If 
    Pointer = StrPtr(sBuffer) 
End Property