Hi all.
here is a novel approach to this very old problem : We are going to open the workbook from an EXE file to ensure that the workbook is (hopefully) ALWAYS open with the Macros enabled !.
Concept : How it works :
The very first time the workbook is ran , the code creates a Standard VB EXE file on the fly (I developped & compiled the EXE in VB6 and stored the EXE bytes in the cells of a hidden sheet inside the workbook). Once the EXE is created, the hidden sheet is no longer needed so the code permanently deletes the hidden sheet.
For convinience, the EXE is automatically saved on the user's desktop as the workbook will be launched from the EXE. (This location can be changed as needed)
Next, the code embeeds the excel workbook as an ADS file inside the "C:\Windows" folder. and gives it the name of "
:ADS_file.dat". There are two reasons for this 1-: so that the EXE file can subsequently easily locate the workbook and open it. 2-: The initial workbook is supposed to be deleted.
Example : (Follow these steps)
1- Download
this workbook and save it somwhere on your disk preferably on your Desktop. (Note the workbook is big in size becuase of the EXE bytes stored in the hidden sheet. This size problem will be resolved once the EXE is created and the hidden sheet is deleted.)
2- With the Macros enabled, Open the workbook and Wait until you are prompted that the EXE file has been created.
3- Now close the workbook and you will see that the EXE file has just been created and saved on your desktop.
4- Now, you no longer need the initial workbook so you can now safely delete it.
5- Finally, disable Excel Macros and open the workbook via the newly created EXE . You will see that the Macros associated with the workbook are working despite Macros being disabled !
You can carry on working with the workbook as normal as well as save any changes.
Limitations:
- Only tested in Excel 2003 Win XP. So I don't know if this will work with other versions.
- The workbook cannot be open via the File>Open Menu. It behaves like a standalone workbook. You just double click it's icon and it is launched in a new excel instance.
-Maybe other issues that I haven't noticed.
Code in the Workbook Module :
Code:
Option Explicit
Private Sub Workbook_Open()
Call Create_exe(True)
End Sub
Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call UpdateFile(True)
End Sub
Code in a Standard Module :
Code:
Option Explicit
Private Declare Function SHGetFolderPath Lib "shfolder" _
Alias "SHGetFolderPathA" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, _
ByVal hToken As Long, ByVal dwFlags As Long, _
ByVal pszPath As String) As Long
Private Const SHGFP_TYPE_CURRENT As Long = 0
Private Const CSIDL_DESKTOPDIRECTORY As Long = &H10
Private Const FILE_PATH_NAME = "C:\Windows" & ":ADS_file.dat"
Public Sub Create_exe(ByVal Dummy As Boolean)
Dim oExeBytesWsh As Worksheet
Dim Var1 As Variant
Dim Var2 As Variant
Dim i As Long
Dim FileNum As Integer
Dim Bytes() As Byte
On Error Resume Next
Set oExeBytesWsh = ThisWorkbook.Worksheets("exeBytes")
If Err.Number = 0 Then
On Error GoTo 0
With ThisWorkbook.Worksheets("exeBytes")
Var1 = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
Var2 = .Range(.Cells(1, 2), .Cells(1, 2).End(xlDown))
End With
ReDim Bytes(LBound(Var1) To UBound(Var1) + UBound(Var2))
For i = LBound(Var1) To UBound(Var1)
Bytes(i) = CByte(Var1(i, 1))
Next
For i = UBound(Var1) To UBound(Var2)
Bytes(i) = CByte(Var2(i, 1))
Next
'
FileNum = FreeFile
Open GetDeskTopFolderPath & "\ForceMacros.exe" _
For Binary As #FileNum
Put #FileNum, 1, Bytes
Close FileNum
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("exeBytes").Visible = xlSheetHidden
ThisWorkbook.Worksheets("exeBytes").Delete
Application.DisplayAlerts = True
Call UpdateFile(True)
MsgBox "EXE created successfully." & _
vbNewLine & "Disable the Macros and run the EXE file"
End If
End Sub
Public Sub UpdateFile(ByVal Dummy As Boolean)
Application.EnableEvents = False
ThisWorkbook.Save
Call EmbeedFile(ThisWorkbook.FullName)
Application.EnableEvents = True
End Sub
Private Sub EmbeedFile(ByVal PathName As String)
Dim Bytes() As Byte
Dim lFileNum As Integer
ReDim Bytes(1 To FileLen(PathName))
lFileNum = FreeFile
Open PathName For Binary Access Read As #lFileNum
Get #lFileNum, , Bytes
Close #lFileNum
lFileNum = FreeFile
Open FILE_PATH_NAME For Binary As #lFileNum
Put #lFileNum, 1, Bytes
Close lFileNum
End Sub
Private Function GetDeskTopFolderPath() As String
Dim sBuffer As String * 260
Dim lngReturn As Long
lngReturn = SHGetFolderPath _
(0, CSIDL_DESKTOPDIRECTORY, 0, SHGFP_TYPE_CURRENT, sBuffer)
GetDeskTopFolderPath = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End Function
I hope this approach proves stable enough and works accross different versions.
