打開文件時比較路徑的VBA代碼

打開時，比較路徑是否爲「\ server \ myfolder1 \ myfolder2 \」。如果爲真，則不做任何事情。如果FALSE，則顯示MSGBOX並關閉文件。

我tryed 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

，當我做一份給我的本地磁盤工作。但是當我從快捷方式或映射指向我的網絡路徑打開時，它不起作用。

小貼士？

來源

2016-05-03 Allan Ferreira

試試下面

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

來源

2016-05-03 13:14:59

應該如何防止打開文件上的快捷方式。 ChDir不會使測試過時，因爲CurDir總是一樣的嗎？如果我沒有正確理解，請向我解釋這一點。非常感謝你。 –

你嘗試了上面的代碼嗎？ chdir只是改變目錄和curdir是當前目錄 –

是的，對不起，我不想攻擊你，我想了解，你改變目錄到一個特定的文件夾，並測試如果活動workbook.path是該文件夾？將不會如果ActiveWorkbook.Path <>「\\ 172.16.5.4 \ BTS-Team」是相同的 –

嘗試使用此方法的驅動器盤符轉換成完整的網絡路徑。微軟參考代碼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

來源

2016-05-03 13:40:43 Rosetta

該如何防止通過快捷方式打開文件？如果你解釋非常感謝，我將不勝感激。 –

如果我們可以將驅動器轉換爲完整的映射路徑，那麼顯然它可以與'LocalFile'字符串 – Rosetta

進行比較，我認爲這不是他的問題，因爲他陳述了比較工作，但不是用於快捷方式，快捷方式只不過是一個指向具有相同路徑的完全相同的文件的指針，這不會解決這個問題，還是將它？無論如何看起來是非常乾淨和良好的代碼;） –

打開文件時比較路徑的VBA代碼

回答

相關問題