• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Lock folder using VBA

YasserKhalil

YasserKhalil

Well-Known Member
Hello everyone
I have found the following piece of code that is supposed to lock folder
Code: 
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal PassZero As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal PassZero As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal Operation As String, ByVal Filename As String, Optional ByVal Parameters As String, Optional ByVal Directory As String, Optional ByVal WindowStyle As Long = vbMinimizedFocus) As Long

Private Const GENERIC_ALL = &H1
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000

Sub Lock_Folder()
    Dim LockFolderPath As String, fHandle As Long

    LockFolderPath = ThisWorkbook.Path & "\TestFolder\"

    If LockFolderPath <> "" Then
        fHandle = CreateFile(LockFolderPath, GENERIC_ALL, ByVal 0&, ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, ByVal 0&)

        ThisWorkbook.Sheets(1).Cells(1, 2) = fHandle
    End If

    MsgBox "Folder Locked...", 64

End Sub

Sub Unlock_Folder()
    Dim fHandle As Long
    fHandle = ThisWorkbook.Sheets(1).Cells(1, 2)

    CloseHandle fHandle
End Sub

I tested it but the folder is not locked .. it is still available
Any idea how to lock and unlock folder using VBA?
 
Just tested & Find working..


Code: 
Option Explicit

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal PassZero As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal PassZero As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal Operation As String, ByVal Filename As String, Optional ByVal Parameters As String, Optional ByVal Directory As String, Optional ByVal WindowStyle As Long = vbMinimizedFocus) As Long

Private Const GENERIC_ALL = &H1
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000

Sub Lock_Folder()

    Dim LockFolderPath As String, fHandle As Long

    LockFolderPath = ThisWorkbook.Path & "\TestFolder"

    If Dir(LockFolderPath, vbDirectory) <> "" Then
        fHandle = CreateFile(LockFolderPath, GENERIC_ALL, ByVal 0&, ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, ByVal 0&)
    'don't delete the such values from the cell
        ThisWorkbook.Sheets(1).Cells(1, 2) = fHandle
            MsgBox "Folder Locked...", 64
    Else
   
        MsgBox "No Such Folder Find", vbCritical
       
    End If


End Sub

Sub Unlock_Folder()
    Dim fHandle As Long
    fHandle = ThisWorkbook.Sheets(1).Cells(1, 2)

    CloseHandle fHandle
End Sub
 

Attachments

  • Lock_a_folder.xlsm
    16.2 KB · Views: 81
Thanks a lot Mr. Deepak for reply and for test
I tested your file too but the same result .. I got the message "Folder Loked" but when trying to open the folder it opened ..it is not locked as supposed to be
 
Thanks a lot Mr. Deepak
Now it is working. I discovered that there was a space in the folder name .. and I was testing on the desktop directly
After moving the files to a new folder and removed the space it worked very well

But now there is an important question ..after locking and the excel file is open it is ok but after saving the excel file and trying to open the folder it is open and not locked ... Is this related to just the excel file open ...?
If so how can I lock the folder even after closing the workbook?!
 
Thanks change to this then work please tell me if User wise can we lock or give access from this code is this possible

means particular user open that folder then lock or particular user we give them access to this folder

please tell me
Code: 
Private Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal PassZero As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal PassZero As Long) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal Operation As String, ByVal Filename As String, Optional ByVal Parameters As String, Optional ByVal Directory As String, Optional ByVal WindowStyle As Long = vbMinimizedFocus) As Long
 
Here's another one!

with attached zip > unzip it & follow below!

Create a folder named Locker in same dire.

Copy-paste or create some stuff in that created folder named Locker.

Double click the locker.bat in the folder > Now it's locked+hidden.

To get it back..

Double click the locker.bat > Input deepak as password to unlock it.

Ref:

http://goo.gl/p2DECV
 

Attachments

  • folder-locker.zip
    415 bytes · Views: 94
 
Thank you very much Mr. Deepak ..
I know this way to lock folder .. I was searching for VBA method ..
Another point this method of using batch file is very easy to crack if you show hidden system files ...
Best regards
 
Nothing is unbreakable for advance user at all, VBA encryption is also breakable however this script can be manipulate to work with VBA.
 
Last edited:
Hi ,

What is the vbDirectory in that code. while i am debugging it comes up to "if " condition. Then directly it goes to the else condition.

Can you please check and assist on this earlier.

In my pc whle debugging vbDirectory shows as 16.
So what is that 16 means
 
balakrishna veerla
You should open a new thread
as written in Forum Rules, please reread

Site Rules - New Users - Please Read

Hi all, Welcome to the Chandoo.org Forums. Posting Rules & Etiquette The Chandoo.org Forums is a collaborative and happy place to learn and expand your Excel knowledge. The Chandoo.org Forums consist of several Sub-Forums based on the type of question/area of Excel you are interested in...
chandoo.org
... I noticed that You done it,
but You didn't thread this to it.
 
You must log in or register to reply here.
Back
Top