Opgelost Converteren Office Excel 97-2003 documents to macro's 2007/2021 xlsm-documents

[Senso]

Ik heb een map vol van deze oude 97-2003 bestanden. Heeft iemand een tool/VBA?
If you have many files, you can create a single macro to automate the process of converting a folder full of .xls files to the .xlsm format, according
Gevonden onderstaande. Kan dit?

Option Explicit
Option Private Module

Sub Main()
    
    Dim strFolder       As String
    
    
    ' browse for a folder
    strFolder = BrowseOneFolder(ThisWorkbook.Path)
    
    
    ' nothing is selected
    If strFolder = "" Then
        Exit Sub
    End If
    
    ' speed up Macro
    Application.ScreenUpdating = False
    Application.Cursor = xlWait
    
    ' rename files in the folder
    ProcessFolder strFolder
    
    ' bring macro back to normal setting
    Application.Cursor = xlDefault
    Application.ScreenUpdating = True
    
    
    ' show completion message
    MsgBox "Done", vbInformation, ""
    
End Sub

Sub ProcessFolder(FolderName As String)
    
    Dim objFSO          As Object
    Dim objFolder       As Object
    Dim objSubfolder    As Object
    Dim objFile         As Object
    
    
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(FolderName)
    
    
    ' process current folder
    For Each objFile In objFolder.Files
        If objFSO.GetExtensionName(objFile.Path) = "xls" Then
            RenameXLStoXLSX objFile
        End If
    Next
    
    
    ' process all subfolders
    For Each objSubfolder In objFolder.SubFolders
        ProcessFolder CStr(objSubfolder)
    Next
    
    
    ' dispose the objects
    Set objFolder = Nothing
    Set objFSO = Nothing
    
End Sub

Sub RenameXLStoXLSX(CurrentFileName)
    
    Dim wbkXLSfile          As Workbook
    Dim strCurrentFileExt   As String
    Dim strNewFileExt       As String
    Dim strNewFileName      As String
    
    
    ' initialize variable
    strCurrentFileExt = ".xls"
    strNewFileExt = ".xlsm"
    strNewFileName = Replace(CurrentFileName, strCurrentFileExt, strNewFileExt)
    
    ' open the original file
    Set wbkXLSfile = Application.Workbooks.Open(CurrentFileName, ReadOnly:=True, AddToMru:=False)
    
    ' always overwrite existing file
    Application.DisplayAlerts = False
    
    ' save to new file format
    wbkXLSfile.SaveAs Filename:=strNewFileName, _
                      FileFormat:=xlOpenXMLWorkbook, _
                      CreateBackup:=False
    
    
    Application.DisplayAlerts = True
    
    
    ' close the file
    wbkXLSfile.Close False
    
End Sub

 

[Senso]

Deze krijg ik niet werkend en ook die eenvoudige die op internet volgens AI werkt niet.

    Sub OpenAndSaveMultipleFiles()
        Dim folderPath As String
        Dim fileName As String
        Dim folderDialog As FileDialog
        Dim wb As Workbook

        ' Prompt user to select a folder
        Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
        If folderDialog.Show = -1 Then
            folderPath = folderDialog.SelectedItems(1) & Application.PathSeparator
        Else
            MsgBox "No folder selected. Exiting macro.", vbExclamation
            Exit Sub
        End If

        ' Get the first file matching the pattern
        fileName = Dir(folderPath & "*.xls*") ' Opens all Excel file types

        ' Loop through all files in the selected folder
        Do While fileName <> ""
            Set wb = Workbooks.Open(folderPath & fileName)
            ' Optional: Perform any other actions on the opened workbook here
            ' Example: wb.Sheets(1).Select ' Select the first sheet
            ' Example: Call YourOtherMacro(wb) ' Call another macro
            wb.Close SaveChanges:=False ' Close without saving changes to the source file
            fileName = Dir
        Loop

        MsgBox "All specified files have been opened and processed.", vbInformation
    End Sub

 

[edmoor]

Zo werkt het hier goed:

Sub ConvertXlStoXLSM()
    Dim folderPath As String
    Dim fileName As String
    Dim folderDialog As FileDialog
    Dim wb As Workbook

    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If folderDialog.Show = -1 Then
        folderPath = folderDialog.SelectedItems(1) & Application.PathSeparator
    Else
        MsgBox "Geen folder geselecteerd.", vbExclamation
        Exit Sub
    End If

    fileName = Dir(folderPath & "*.xls")
    Do While fileName <> ""
        Set wb = Workbooks.Open(folderPath & fileName)
        wb.SaveAs folderPath & Left(wb.Name, Len(wb.Name) - 4), 52
        wb.Close SaveChanges:=False
        fileName = Dir
    Loop

    MsgBox "Alle .xls bestanden zijn geconverteerd naar .xlsm.", vbInformation
End Sub

Er kan een uitgebreidere fout afhandeling in maar dat is denk ik niet nodig.

 

[Senso]

Bedankt.
Kun je ook nog voor regen zorgen?

 

[edmoor]

Bier ook goed?