Saveas xlsm in xlsx without opening files-CodePudding

Sorry to bother you, but I'm at an impasse :(

To summarize my situation, I need to recover an entire sheet of all files in a folder. My macro goes through them one by one and picks it up.

The problem is that I can have "xlsm" files that show me a warning pop up because there are macros and "trust" etc... Pop up that I can't remove because it doesn't cannot be disabled. (I also can't change my excel options for X reasons because I'm not the only one using the macro).

I would therefore like to convert my "xlsm" to "xlsx" without having to open it to avoid the pop up. A simple change of extension damages the file (obvious)

Do you have a solution for saveas without opening the file or opening it without having the pop-up?

Thanks in advance !

CodePudding user response：

Make the macro to open the files as read-only, so the pop up doesn't apear regarding trust.

Set my_wb = Workbooks.Open(Filename:=file_path, ReadOnly:=True)

And make the make macro to save the files as xlsx

Application.DisplayAlerts = False
my_wb.SaveAs fileName:="myFileName.xlsx"

CodePudding user response：

As I said in my above comment, adding the folder where the workbooks in discussion exist in Excel Trusted Locations can be a solution, to avoid warnings related to trustful workbooks. Adding the folder path, in code, can be done in the next way:

Private Function CreatePathInTrLoc(ByVal sPath As String, ByVal sDescription As String, Optional boolReplace As Boolean) As Boolean
    Const HKEY_CURRENT_USER = &H80000001, sAppExe As String = "excel.exe", sApp As String = "Excel"
    Dim oRegistry As Object, sAppVer As String, sParentKey As String, bAlreadyExists As Boolean
    Dim arrChildKeys As Variant, sChildKey As Variant, sValue As String, sNewKey As String
    Dim iLocCounter As Long, strReplace As String, sExtPath As String
    
    Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
    sAppVer = GetAppVersion(sAppExe)
    sAppVer = left(sAppVer, InStr(sAppVer, ".") - 1) & "." & Mid(sAppVer, InStr(sAppVer, ".")   1, 1)
    
    sParentKey = "Software\Microsoft\Office\" & sAppVer & "\" & sApp & "\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
            If boolReplace Then
                oRegistry.GetStringValue HKEY_CURRENT_USER, sParentKey & "\" & sChildKey, "Path", sExtPath
                If sExtPath <> sPath Then
                    oRegistry.DeleteKey HKEY_CURRENT_USER, sParentKey & "\" & sChildKey
                    strReplace = sChildKey
                    GoTo OverDeleteKey
                Else
                    bAlreadyExists = True
                    CreatePathInTrLoc = True
                End If
            Else
                bAlreadyExists = True
                CreatePathInTrLoc = True
            End If
        End If
        
        If CInt(Mid(sChildKey, 9)) > iLocCounter Then
            iLocCounter = CInt(Mid(sChildKey, 9))
        End If
    Next
OverDeleteKey:
    
    If Not bAlreadyExists Then
        sNewKey = sParentKey & IIf(strReplace <> "", "\" & strReplace, "\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
        oRegistry.SetDWORDValue HKEY_CURRENT_USER, sNewKey, "AllowSubFolders", 1
    
        CreatePathInTrLoc = True
        Debug.Print "Path """ & sPath & """ added in Trusted Locations."
    Else
       Debug.Print "Path """ & sPath & """ already exists..."
    End If
End Function
Private Function GetAppVersion(sAppExe As String) As String 'extract application version
    Const HKEY_LOCAL_MACHINE = &H80000002
    Dim oRegistry As Object, oFSO As Object, sKey As String, sValue As String

    Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/default:StdRegProv")
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    sKey = "Software\Microsoft\Windows\CurrentVersion\App Paths"

    oRegistry.GetStringValue HKEY_LOCAL_MACHINE, sKey & "\" & sAppExe, "", sValue
    GetAppVersion = oFSO.GetFileVersion(sValue)

    Set oFSO = Nothing: Set oRegistry = Nothing
End Function

The above solution can be tested as:

Sub testCreatePathInTrLoc()
  Debug.Print CreatePathInTrLoc("C:\temp", "TestLocation")
End Sub

The called Sub needs as parameters: folder path to be added, Trusted location name/description and a Boolean Optional parameter if you want replacing an existing trusted location.