如何保護我的excel文件不被其他人閱讀？

Question

基本上，我想開發一個辦公室excel插件。 安裝此插件后，創建的所有excel文件只能由excel安裝了此插件的用戶打開。 所以我在這里有兩個問題：

1. 我可以使用VBA開發它，或者我必須使用C＃或VB將其開發為應用程序級別的插件嗎？
2. 怎么做？ 看起來我必須在保存時稍微修改excel文件格式，這樣沒有這個插件的另一個excel會認為這是一個損壞的文件。 有沒有excel API這樣做？ 如果沒有，你有更好的想法嗎？

Answer 1

美麗的問題:)

是的，它可以在VBA Excel加載項中實現。 事實上，幾年前我確實實現了類似的功能。 這是以4個步驟解釋的邏輯。

通過加載項創建文件時，請按照下列步驟操作

1）將文件保存在Temp directory如Temp.xls ，密碼用密碼保護。 您可以選擇保留固定密碼或動態 密碼 。 請參閱此代碼以創建動態密碼。

Function GenerateRandPassword() As String
    Dim strEnvPass As String, strPass As String
    Dim n As Integer

    strEnvPass = "@#$%^"
    n = Application.WorksheetFunction.RandBetween(1, 10)

    For i = 1 To 5
        strPass = strPass & n
    Next i

    strPass = strEnvPass & strPass & strEnvPass

    GenerateRandPassword = strPass
End Function

要測試它，只需像這樣調用它

Sub Sample()
    Debug.Print GenerateRandPassword
End Sub

密碼將采用此格式

@#$%^11111@#$%^
@#$%^22222@#$%^
@#$%^33333@#$%^
.
.
.
@#$%^1010101010@#$%^

當您嘗試通過加載項打開文件時，循環1到10並使用@#$%^作為后綴和前綴來創建密碼，然后嘗試打開該文件。 這樣您的Excel文件將具有隨機密碼。 請參閱有關如何打開這些文件的第4點。

IMP ：不要在Application.WorksheetFunction.RandBetween(1, 10)選擇太大的數字。它只會延遲稍后打開文件。

2）要獲取臨時目錄，請使用此代碼

Private Declare Function GetTempPath _
Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

Sub TmpPath()
    'This will give the Temp Path
    MsgBox TempPath
End Sub

3）在臨時目錄中創建文件后，重命名該文件並為其提供Excel無法識別的擴展名，例如MyFile.ice （從您的SO句柄中iceagle 3個字母）

您可以使用此代碼重命名該文件

Name TempPath & "MyFile.xls" As "C:\\MyFile.Ice"

這樣普通用戶就不知道打開這個文件需要哪個應用程序。

要打開此文件，可以在Application.GetOpenFilenam中將過濾器設置為*.ice

Sub Sample()
    fileToOpen = Application.GetOpenFilename("ICE Files (*.ice), *.ice")
    If fileToOpen <> False Then
        Application.DisplayAlerts = False
        Workbooks.Open (fileToOpen)
        Application.DisplayAlerts = True
    End If
End Sub

4）要打開文件，請使用此代碼

Sub OpenFile()
    Dim wb As Workbook
    Dim strPass As String

    For i = 1 To 10
        On Error Resume Next
        strPass = "@#$%^" & i & i & i & i & i & "@#$%^"
        Set wb = Workbooks.Open("C:\MyFile.ice", , , , strPass)
        If Err.Number = 0 Then Exit For
        Err.Clear
    Next
    On Error GoTo 0
End Sub

希望這能讓你開始:)