Question

我想在文件路径打开时进行比较。

打开时，比较路径是＆＃34; \ server \ myfolder1 \ myfolder2 \＆＃34;。如果为TRUE，则什么都不做。如果为FALSE，则显示MSGBOX并关闭文件。

我尝试了以下代码：

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

尝试将驱动器号转换为完整的网络路径。 Microsoft参考代码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

Answer 2

尝试以下

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

用于比较文件打开时的路径的VBA代码

2 个答案: