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