Datei nur von bestimmten Speicherort starten

Forumthread: Datei nur von bestimmten Speicherort starten

29.05.2018 07:13:48

bestimmten

Guten Morgen zusammen,
ich habe eine Excel-Datei in unserem Netzwerk bereitgestellt. Die Datei soll nur von diesem Ort aus lauffähig sein, damit sich nicht jemand die Datei auf den eigenen Rechner zieht und irgendwann mal mit einer alten Version arbeitet.
Hierzu wollte ich den Pfad unter Thisworkbook.path mit dem Netzwerkpfad vergleichen. Aber leider geht das nicht aufgrund der unterschiedlichen Schreibweisen (Q\xxx\xxxx\Datei.xlsm im Vergleich zum Netzwerkpfad \\xxx\xxxx\Datei.xlsm).
Wenn die Datei mit einem bestimmten Button gespeichert wird, bekommt sie ein Kennzeichen gesetzt, so das die Speicherortüberprüfung beim nächsten Start ausgesetzt wird.
Hat jemand eine Idee, wie man das realisieren kann ?
Bin für Eure Vorschläge dankbar.
Viele Grüße
Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Datei nur von bestimmten Speicherort starten

29.05.2018 08:55:36

bestimmten

Hallo Stefan,
1. Vergleichst du eine File-Qualifizierung und nicht nur eine Path-Qualifizierung.
2. Musst du generell die UNC-Notation verwenden.
3. Hier ein Beispiel:

'-------------------------------------------------------------------------------------
' Diese Code in ein Modul
' translate DOS-Based DrivePathFilename to UNC-Notation
Public Function UNCpath(ByVal sPathWithDriveLetter As String) As String
Dim objNtWork  As Object
Dim objDrives  As Object
Dim lxDrive    As Long
Set objNtWork = CreateObject("WScript.Network")
Set objDrives = objNtWork.enumnetworkdrives
UNCpath = sPathWithDriveLetter
For lxDrive = 0 To objDrives.Count - 1 Step 2
If UCase(objDrives.Item(lxDrive)) = UCase(Left(sPathWithDriveLetter, 2)) Then
UNCpath = objDrives.Item(lxDrive + 1) & Right(sPathWithDriveLetter, Len( _
sPathWithDriveLetter) - 2)
Exit For
End If
Next
Set objNtWork = Nothing
Set objDrives = Nothing
End Function
Sub Test()             ' "UNC Pfad anpassen"
If UNCpath(ThisWorkbook.FullName) = "\\Server\Dir\SubDir\" & ThisWorkbook.Name Then
MsgBox "Ist auf dem Netzwerk!", vbInformation
Else
MsgBox "Ist lokal gespeichert!", vbCritical
End If
End Sub

Gruess Hansueli

AW: Datei nur von bestimmten Speicherort starten

29.05.2018 11:07:50

bestimmten

Hallo Hansueli,
vielen Dank für Deine Rückmeldung.
Da muss ich mich erst mal reindenken :-)
Ich denke, dass ist genau das was ich suche, aber da brauche
ich ein wenig Zeit für.
Toll, dass einem hier immer geholfen wird !
Viele Grüße
Stefan

AW: Datei nur von bestimmten Speicherort starten

29.05.2018 08:55:58

bestimmten

Hallo
du könntest dir den UNC- Pfad aus den jeweils "Lokalen Pfaden" ermitteln und den dann abgleichen.
z.B. mit folgender Function.


Private Declare Function WNetGetConnection Lib "mpr.dll" _
    Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, _
                                ByVal lpszRemoteName As String, _
                                cbRemoteName As Long) As Long

Public Function GetUNCPath(ByVal sLocalPath As String) As String
'// ----------------------------------------------------------------- 
'// Methode:   | Konvertiert einen Pfad in UNC-Pfad (\\SERVER\...) 
'// ----------------------------------------------------------------- 
'// Parameter: | sLocalPath = gültiger, lokaler Pfad (X:\..) 
'// ----------------------------------------------------------------- 
'// Rückgabe:  | bei Erfolg = UNC-Pfad 
'//            | bei Fehler = sLocalPath 
'// ----------------------------------------------------------------- 
    Const NO_ERROR  As Long = 0
    Dim sUNCPath    As String
    Dim sResult     As String
    Dim sDrive      As String
   
    GetUNCPath = sLocalPath
    If VBA.Mid$(sLocalPath, 2, 1) <> ":" Then Exit Function
'// Die API-Funktion benötigt nur das Laufwerk! 
    sDrive = VBA.Left$(sLocalPath, 2)
    sUNCPath = VBA.String(260, 0)
    If WNetGetConnection(sDrive, sUNCPath, VBA.Len(sUNCPath)) = NO_ERROR Then
        sResult = VBA.Left$(sUNCPath, VBA.InStr(sUNCPath, vbNullChar) - 1)
        If VBA.Len(sResult) > 0 Then
            GetUNCPath = sResult & VBA.Mid$(sLocalPath, 3)
        End If
    End If
End Function

Aufrufen z.B. so..

Sub HAllo()
    Dim DerRichtigePfad As String
    
    DerRichtigePfad = "\\Server\Freigabe\...\Test.xlsm"
    If GetUNCPath(ThisWorkbook.FullName) = DerRichtigePfad Then
        MsgBox "erlaubt"
    Else
        MsgBox "leider nein"
        Exit Sub
    End If
End Sub

LG UweD

AW: Datei nur von bestimmten Speicherort starten

29.05.2018 11:12:46

bestimmten

Hallo Uwe,
besten Dank für Deine Rückmeldung.
Da muss ich mich erst mal reindenken :-)
Deine Lösung ist ja so ähnlich wie die von Hansueli...
Ich denke, dass ist genau das was ich suche, aber da brauche
ich ein wenig Zeit für.
Toll, dass einem hier immer geholfen wird !
Viele Grüße
Stefan

AW: Datei nur von bestimmten Speicherort starten

29.05.2018 10:01:14

bestimmten

Hallo Stefan,
du kannst versuchen eine Workbook-Open-Prozedur nach folgendem Schema anzulegen.

'Makro unter diese Arbeitsmappe
Private Sub Workbook_Open()
Dim Kennzeichen
Dim strPfad
Kennzeichen = "" 'kennzeichen einlesen               'anpassen !!!!
If Kennzeichen = "" Then 'Kennzeichen ist noch nicht gesetzt
'Prüfen der ersten 3 Zeichen der Speicherpfades
Select Case LCase(Left(Me.Path, 3))
'ggf. weiter lokale Laufwerke oder Standard verviundene Netzlaufwerke _
ergänzen
Case Is = "a:\", "b:\", "d:\", "e:\", "f:\", "g:\", "y:"
MsgBox "Diese Datei darf nicht von diesem Laufwerk " _
& Left(Me.Path, 3) & "gestartet werden!" & vbLf & vbLf _
& "Datei wird wieder geschlossen!"
Me.Close savechanges:=False
Case Else
'ermitteln des Speicherpfades
If InStr(Me.Path, "\\") > 0 Then
strPfad = LCase(Mid(Me.Path, InStr(Me.Path, "\\") + 1))
Else
strPfad = LCase(Mid(Me.Path, InStr(Me.Path, ":\") + 1))
End If
'Prüfen des Speicherpfades
If strPfad = LCase("\xxx\xxxx\xxxx") Then       'anpassen !!!!
'Datei wurde zum 1. mal geöffnet aus dem richtigen Verzeichnis
Else
MsgBox "Diese Datei wurde nicht vom korrekten Speicherort " & _
"aus gestartet!" & vbLf & vbLf _
& "Datei wird wieder geschlossen!"
Me.Close savechanges:=False
End If
End Select
Else
'Datei wurde schon mal gespeichert
End If
End Sub

Funktioniert natürlich nur, wenn die Ereignis-Makros beim Öffnen der Datei auch aktiv sind. Diese Einstellung kann ein etwas erfahrener User ggf. vor dem Öffnen der Datei per Makro deaktivieren.
Gruß
Franz

AW: Datei nur von bestimmten Speicherort starten

29.05.2018 11:13:50

bestimmten

Hallo Franz,
vielen Dank für Deine Rückmeldung.
Ich schaue mir auch Deine Lösung an, sobald hier mal
wieder ein wenig Ruhe einkehrt... :-)
Toll, dass einem hier immer geholfen wird !
Viele Grüße
Stefan

Beliebteste Forumthreads (12 Monate)

Datei nur von bestimmten Speicherort starten

Forumthread: Datei nur von bestimmten Speicherort starten

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread