Sub RunWordMacroFromExcel()
    Dim xlWorksheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim wordApp As Word.Application
    Dim wordDoc As Word.Document
    Dim filePath As String

    ' Set your worksheet name here
    Set xlWorksheet = ThisWorkbook.Sheets("Sheet1")

    lastRow = xlWorksheet.Cells(xlWorksheet.Rows.Count, "A").End(xlUp).Row

    ' Create a new instance of the Word application
    Set wordApp = New Word.Application
    wordApp.Visible = False ' Set to True for debugging

    ' Loop through each file path in your Excel list
    For i = 1 To lastRow
        filePath = xlWorksheet.Cells(i, "A").Value
        
        ' Check if the file path is not empty
        If filePath <> "" Then
            On Error Resume Next ' In case a file is not found
            
            ' Open the Word document
            Set wordDoc = wordApp.Documents.Open(filePath)

            If Not wordDoc Is Nothing Then
                ' Run the macro stored in Word's Normal.dotm
                wordApp.Run "CompressPhotosWebSaveAndClose"
                
                ' Save and close the document
                wordDoc.Save
                wordDoc.Close
            Else
                ' Handle errors for files that could not be opened
                MsgBox "Could not open file: " & filePath, vbExclamation
            End If
            
            On Error GoTo 0 ' Resume normal error handling
        End If
    Next i

    ' Clean up and close the Word application
    wordApp.Quit
    Set wordDoc = Nothing
    Set wordApp = Nothing
    
    MsgBox "Batch process complete!", vbInformation
End Sub