ms-access-2007 - 絶対画像パスの取得

Question

パスの末尾に画像名 (\image1.jpg など) を持つ画像フォルダーへの絶対パスを取得したいと考えています。ここで、ImagePath はテーブル内の画像パス フィールドの名前です。正しくフォーマットする方法がわかりません。

どうすればいいですか？

これが私がすでに試したことです：

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

Answer 1

GetUNCPathは、ネットワーク ドライブ全体で任意のパスを汎用名前付け規則のパスに変換するメソッドです。ネットワークに接続されていない場合は、絶対パスとしてローカル ドライブを返します。この関数を使用して、完全な絶対パスがあることを保証します。

パスを完全な絶対 UNC パスに簡単に変換できるように、 ( @GSergの助けを借りて) 以下のコードを作成しました。

使用法

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