ファイルを開いたときのパスを比較するVBAコード

Question

開いているときのファイルパスを比較したいと思います。

パスを開くと、パスが "\ server \ myfolder1 \ myfolder2 \"であるかどうかを比較します。 TRUEの場合は何もしないでください。 FALSEの場合は、MSGBOXを表示してファイルを閉じます。

私は、TE次のコードをしようと試みた：私は私のローカルディスクにコピーを作成するときには機能し

Private Sub Workbook_Open() 

Dim LocalFile As String 
LocalFile = "\\Server\folder1\folder2" 

If ActiveWorkbook.Path <> LocalFile Then 
MsgBox ("This file is not original") 

End If 

Range("B2").Value = ActiveWorkbook.Path 

End Sub 

を。しかし、私がショートカットやネットワークパスを指すマッピングから開くと、動作しません。

ヒント？

Answer 1

は、完全なネットワークパスにドライブ文字を変換しよう

Private Sub Workbook_Open() 
    ChDir ("\\172.16.5.4\BTS-Team") 
    If ActiveWorkbook.Path <> CurDir Then 
     MsgBox ("This file is not original") 
    End If 
    Range("B2").Value = ActiveWorkbook.Path 
End Sub 

Answer 2

の下にこれを試してみてください。マイクロソフトの参照コードhere。

は、ここでそのショートカットを介してファイルを開くことを防止する方法完全なネットワークパス

Option Explicit 

Declare Function WNetGetConnection32 Lib "MPR.DLL" Alias _ 
    "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal _ 
    lpszRemoteName As String, lSize As Long) As Long 

Sub Test() 
    If Not IsError(GetNetPath("Z")) Then 
     MsgBox GetNetPath("Z") 
    Else 
     MsgBox "Error" 
    End If 
End Sub 

Function GetNetPath(ByVal DriveLetter As String) 
    Dim lpszRemoteName As String * 255 
    Dim cch As Long 
    Dim lStatus As Long 

    DriveLetter = DriveLetter & ":" 
    cch = 255 
    lStatus = WNetGetConnection32(DriveLetter, lpszRemoteName, cch) 

    If lStatus& = 0 Then 
     GetNetPath = application.clean(lpszRemoteName) 
    Else 
     GetNetPath = CVErr(xlErrNA) 
    End If 
End Function 

Private Sub Workbook_Open() 

    Dim LocalFile As String 
    Dim CurrentPath As String 
    Dim CurrentDrive As String * 1 
    Dim CurrentDriveMap As Variant 

    LocalFile = "\\Server\folder1\folder2" 
    CurrentPath = ThisWorkbook.Path 
    CurrentDrive = CurrentPath 
    CurrentDriveMap = GetNetPath(CurrentDrive) 
    If Not IsError(CurrentDriveMap) Then 
     CurrentPath = CurrentDriveMap & Mid(CurrentPath, 3, Len(CurrentPath))    
    End If 
    If CurrentPath <> LocalFile Then 
     GoTo NotOriginalHandler 
    End If 
    Range("B2").Value = ActiveWorkbook.Path 
    Exit Sub 

NotOriginalHandler: 
    MsgBox ("This file is not original") 
    ThisWorkbook.Close 
End Sub