如何通过VBA将PPT转为PPTX时保留文件属性（作者、日期等）

我懂你的困扰——批量转格式时丢了原文件的作者、创建/修改日期这些元数据确实糟心。其实只需要在你的VBA代码里加几步，读取原PPT的属性再赋值给新生成的PPTX文件就行。

先给你补全并修改后的完整代码，关键部分我都加了注释：

Sub BatchSave()
    ' 批量将指定文件夹中的PPT文件转换为PPTX格式，并保留原文件属性
    Dim sFolder As String
    Dim sPresentationName As String
    Dim oPresentation As Presentation
    Dim fDialog As FileDialog
    Dim fs As Object ' FileSystemObject，用于获取/修改文件属性
    Dim originalFile As Object ' 原PPT文件对象
    Dim newFile As Object ' 新生成的PPTX文件对象
    
    ' 选择目标文件夹
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "选择包含PPT文件的文件夹"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub ' 用户取消选择则退出
        sFolder = .SelectedItems(1) & "\"
    End With
    
    ' 初始化FileSystemObject（Late Binding，无需手动引用）
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    ' 遍历文件夹中的PPT文件
    sPresentationName = Dir(sFolder & "*.ppt")
    Do While sPresentationName <> ""
        ' 跳过PPTX文件（避免重复处理）
        If LCase(Right(sPresentationName, 4)) = ".ppt" Then
            On Error Resume Next ' 处理打开文件失败的情况（比如文件被占用）
            Set oPresentation = Presentations.Open(sFolder & sPresentationName, ReadOnly:=msoTrue)
            On Error GoTo 0
            
            If Not oPresentation Is Nothing Then
                Dim newFileName As String
                ' 生成新的PPTX文件名
                newFileName = Left(sFolder & sPresentationName, Len(sFolder & sPresentationName) - 4) & ".pptx"
                
                ' 保存为PPTX格式
                oPresentation.SaveAs newFileName, ppSaveAsOpenXMLPresentation
                oPresentation.Close
                
                ' --------------------------
                ' 核心步骤：保留原文件属性
                ' --------------------------
                Set originalFile = fs.GetFile(sFolder & sPresentationName)
                Set newFile = fs.GetFile(newFileName)
                
                ' 同步系统级日期属性：创建日期、最后修改日期
                newFile.DateCreated = originalFile.DateCreated
                newFile.DateLastModified = originalFile.DateLastModified
                
                ' 重新打开新PPTX，同步文档内置属性（作者、标题等）
                Set oPresentation = Presentations.Open(newFileName, ReadOnly:=msoFalse)
                With oPresentation.BuiltInDocumentProperties
                    ' 复制原文件的作者（索引2对应作者，不同系统语言可能微调）
                    .Item("Author").Value = originalFile.GetDetailsOf(originalFile, 2)
                    ' 复制原文件标题（可选）
                    .Item("Title").Value = originalFile.GetDetailsOf(originalFile, 1)
                    ' 复制原文件备注（可选）
                    .Item("Comments").Value = originalFile.GetDetailsOf(originalFile, 4)
                End With
                oPresentation.Save
                oPresentation.Close
            End If
        End If
        sPresentationName = Dir
    Loop
    
    ' 释放占用的对象
    Set fs = Nothing
    Set originalFile = Nothing
    Set newFile = Nothing
    Set oPresentation = Nothing
    
    MsgBox "批量转换完成！所有文件已保留原属性。", vbInformation
End Sub

关键细节说明： #

• FileSystemObject：用来读取原PPT的系统级属性（创建/修改日期），还能直接修改新文件的这些日期，用Late Binding（CreateObject）不用手动添加引用，兼容性更强。
• BuiltInDocumentProperties：负责同步PPTX的内置元数据（作者、标题等），这里用GetDetailsOf读取原文件的属性值，再赋值给新文件。如果属性索引不对（比如系统是中文/英文差异），可以调整数字试试。
• 加了错误处理：避免因文件被占用等情况导致程序崩溃。

使用小提醒： #

1. 运行代码前，记得关闭所有正在编辑的PPT文件，防止冲突。
2. 如果某些属性不需要同步，直接删掉对应的赋值代码就行。

内容的提问来源于stack exchange，提问作者Gofurther