Dim args, FileName
Set args = WScript.Arguments
If args.Count > 0 Then
    FileName = args(0)
    msgbox "create accde from " & FileName
    If CreateLockedAccde(FileName) then
       msgbox "accde built"
    end if
Else
    WScript.Echo "File name required"
    WScript.Quit 1
End If
Function CreateLockedAccde(SourceFilePath)
    dim AccessApp, DestFilePath
   
    Set AccessApp = CreateObject("Access.Application")
    AccdeFilePath = Replace(SourceFilePath, ".accdb", ".accde")
    if CreateAccde(AccessApp, SourceFilePath, AccdeFilePath) then
        CreateLockedAccde = LockApplication(AccessApp, AccdeFilePath)
    End if
   
End Function
Function CreateAccde(AccessApp, SourceFilePath, DestFilePath)
    DeleteFile DestFilePath
    AccessApp.SysCmd 603, (SourceFilePath), (DestFilePath)
    CreateAccde = True
End Function
Sub DeleteFile(File2Delete)
   set fso = CreateObject("Scripting.FileSystemObject")
   if fso.FileExists(File2Delete) then
      fso.DeleteFile File2Delete
   end if
End Sub
Function LockApplication(AccessApp, FileName)
    dim dbe, db
    Const dbBoolean = 1
    Set dbe = AccessApp.DBEngine
    Set db = dbe.OpenDatabase(FileName)
 
    SetDbProperty db, "AllowBypassKey", dbBoolean, False
    SetDbProperty db, "AllowSpecialKeys", dbBoolean, False
    '...
   
    db.Close
    LockApplication = True
   
End Function
Sub SetDbProperty(db, PropName, PropType, PropValue)
On Error resume Next
    db.Properties(PropName) = PropValue
 
    if Err.Number = 3270 Then
        db.Properties.Append db.CreateProperty(PropName, PropType, PropValue)
    elseif Err.Number <> 0 then
        Err.Raise Err.Number, "SetDbProperty", Err.Description
    end if
 
End Sub