Office: currentDB mit UNC

Hallo allerseits,
meineDatenbank wird mit currentDB lokalisiert.
Beispiel: msgbox currentDB liefert c:\daten\meineDatenbank.
Ich möchte aber \\computername\c\daten geliefert bekommen.
Geht das?

Danke im Voraus: Granados

 

Hallo,

Msgbox CurrentDB liefert mir einen Fehler.
aber mit

Code:

str = "\\" & Environ("Computername") & "\"..... 
str = Replace (str, ":", "")

könntest Du Dir Deinen Ausdruck zusammenbasteln.

Gruß
Doming

 

Bei mir funktioniert

Code:

Dim str as string

str = "\\" & Environ("Computername") & "\" & CurrentProject.Path
str = Replace (str, ":", "")
MsgBox str

 

wenn das lokale directory auf ein Netzlaufwerk gemapt ist hilft:

Code:

Option Explicit

#If VBA7 Then
    ' Für 64-Bit VBA (Office 64-Bit)
    Private Declare PtrSafe Function WNetGetUniversalName Lib "mpr.dll" Alias "WNetGetUniversalNameA" ( _
        ByVal lpLocalPath As String, _
        ByVal dwInfoLevel As Long, _
        ByVal lpBuffer As LongPtr, _
        ByRef lpBufferSize As Long) As Long
#Else
    ' Für 32-Bit VBA (ältere Office-Versionen)
    Private Declare Function WNetGetUniversalName Lib "mpr.dll" Alias "WNetGetUniversalNameA" ( _
        ByVal lpLocalPath As String, _
        ByVal dwInfoLevel As Long, _
        ByVal lpBuffer As Long, _
        ByRef lpBufferSize As Long) As Long
#End If

Private Const UNIVERSAL_NAME_INFO_LEVEL As Long = &H1
Private Const ERROR_MORE_DATA As Long = 234&
Private Const NO_ERROR As Long = 0&

Public Function LokalerPfadNachUNC(ByVal LokalerPfad As String) As String
    Dim lngRet As Long
    Dim lngBufferSize As Long
    Dim strBuffer As String

    ' Ersten Aufruf starten, um benötigte Buffergröße zu bekommen
    lngRet = WNetGetUniversalName(LokalerPfad, UNIVERSAL_NAME_INFO_LEVEL, 0, lngBufferSize)
    
    If lngRet = ERROR_MORE_DATA Then
        ' Puffer anlegen
        strBuffer = String$(lngBufferSize, vbNullChar)
        
        ' Zweiter Aufruf mit Buffer
        lngRet = WNetGetUniversalName(LokalerPfad, UNIVERSAL_NAME_INFO_LEVEL, StrPtr(strBuffer), lngBufferSize)
        
        If lngRet = NO_ERROR Then
            ' UNC-Pfad auslesen (Null-Bytes entfernen)
            LokalerPfadNachUNC = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
            Exit Function
        End If
    End If
    
    ' Falls lokales Laufwerk → Originalpfad umwandeln
    LokalerPfadNachUNC =Replace ("\\" & Environ("Computername") & "\" & LokalerPfad, ":", "")
End Function

 

Danke, beide Funktionen kann ich nachvollziehen und brauchen.

Vielen Dank und einen guten Tag wünscht: Granados