Saveas xlsm in xlsx without opening files - excel

Question

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 !

Answer 1

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"

Answer 2

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.