• 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.

An executable file to enable macros in Excel files

Hany ali

Active Member
hello ever body,i want to help me to get Code for all excel Files to make enable Macros
like this Code ,but this one for access -i want the same one for Excel
Code:
 Const HKEY_CURRENT_USER = &H80000001
 
    Dim oRegistry   
    Dim sPath   
    Dim sDescription   
    Dim bAllowSubFolders   
    Dim bAllowNetworkLocations   
    Dim bAlreadyExists   
    Dim sParentKey   
    Dim iLocCounter   
    Dim arrChildKeys   
    Dim sChildKey   
    Dim sValue   
    Dim sNewKey   

    Set WshShell = CreateObject("WScript.Shell")
    strCurDir = WshShell.CurrentDirectory

    Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
    sPath = strCurDir

    sDescription = "YourTrustedLocationDescriptionGoesHere"
    bAllowSubFolders = True
    bAlreadyExists = False

    sParentKey = "Software\Microsoft\Office\16.0\Access\Security\Trusted Locations"
'    sParentKey = "Software\Microsoft\Office\16.0\Excel\Security\Trusted Locations"
'    sParentKey = "Software\Microsoft\Office\16.0\PowerPoint\Security\Trusted Locations"
'    sParentKey = "Software\Microsoft\Office\16.0\Word\Security\Trusted Locations"
    iLocCounter = 0
    oRegistry.EnumKey HKEY_CURRENT_USER, sParentKey, arrChildKeys
    For Each sChildKey in arrChildKeys
        oRegistry.GetStringValue HKEY_CURRENT_USER, sParentKey & "\" & sChildKey, "Description", sValue
         If sValue = sDescription Then bAlreadyExists = True

        If CInt(Mid(sChildKey, 9)) > iLocCounter Then
                iLocCounter = CInt(Mid(sChildKey, 9))
            End If
    Next

    'If bAlreadyExists = False Then
        sNewKey = sParentKey & "\Location" & CStr(iLocCounter + 1)

        oRegistry.CreateKey HKEY_CURRENT_USER, sNewKey
        oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Path", sPath
        oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Description", sDescription

        If bAllowSubFolders Then
            oRegistry.SetDWORDValue HKEY_CURRENT_USER, sNewKey, "AllowSubFolders", 1

        End If



Office 2019 : 16.0


Office 2016 : 16.0


Office 2013 : 15.0


Office 2010 : 14.0


Office 2007 : 12.0


Office 2003 : 11.0
Thanks and Best Regards
 
hi
take this Script,it's work With Excel
Code:
Option Explicit

Dim xlApp, xlBook

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

  ' Import Add-Ins
xlApp.Workbooks.Open "C:\<pathOfXlaFile>\MyMacro.xla"
xlApp.AddIns("MyMacro").Installed = True

'
Open Excel workbook
Set xlBook = xlApp.Workbooks.Open("<pathOfXlsFile>\MyExcel.xls", 0, True)

' Run Macro
xlApp.Run "Sheet1.MyMacro"

xlBook.Close
xlApp.Quit

Set xlBook = Nothing
Set xlApp = Nothing

WScript.Quit
 
Back
Top