如何使用VBA创建的新PPT演示文稿添加到最近打开的文件列表中？-解网

问：

我们的一位用户最近注意到，我们工具栏中用于创建新演示文稿的按钮 - 在生成正确的内容并将其保存到正确的位置 - 不会将这些新演示文稿添加到“最近使用的文件”列表中。

例如，运行以下代码将创建一个新的 .pptx 文件并将其保存到默认保存路径，但这个新的“test.pptx”不会出现在“最近打开的文件”列表中，即使用户花费数小时编辑文件并正确保存并关闭：

Public Sub testRecentFiles()

    Dim test1 As Presentation
    Dim presPath As String
    
    presPath = Environ("USERPROFILE") & strDEFAULT_SAVE_PATH & "test.pptx"
    
    Set test1 = Application.Presentations.Add
    test1.SaveAs presPath

    test1.Close
    Application.Presentations.Open presPath, msoFalse, msoFalse, msoTrue


End Sub

我尝试添加最后两行以关闭新文件并重新打开它，希望这会触发最近使用的文件列表，但没有运气。

当然，当我从文件资源管理器打开“test.pptx”时，它会出现在PowerPoint的“最近打开的文件”列表中。但默认情况下，VBA 代码似乎不会触发填充“最近打开的文件”列表的任何事件。

这是一个问题，因为我们的工具栏经常创建新的演示文稿，并且当用户对他们正在使用的文件夹没有写入权限时，有时必须将它们移动到默认保存路径。我的偏好是在保存新演示文稿后触发最近文件更新。

在我的研究中，我看到 Excel 对象模型具有 RecentFiles 方法，该方法允许 VBA 开发人员将任何文件添加到 RecentFiles 列表中。

但是，尝试如下操作（在 Excel 中有效）在 PPT 中不起作用，因为 PPT 对象模型中似乎没有 RecentFiles 方法：

''' Application.RecentFiles.Add presPath '''

VBA 幻灯片

1赞 PeterT 11/16/2023

它看起来像存在于 Excel、Word、Visio 和 Project 中，但不存在于 PowerPoint 中。我会认为它即将到来，但是当???不过，如果您想经历修改注册表的麻烦，您可能会得到您想要的。RecentFiles

1赞 Steve Rindsberg 11/16/2023

即便如此，正如链接页面中所指出的，您必须重新启动 PowerPoint，然后它才会重新读取注册表值。

答：

0赞 egerz 11/22/2023 #1

提到这样做的唯一方法是修改注册表的评论是正确的，并为我指明了正确的方向，所以我发布了我的解决方案，以防其他人偶然发现这个问题，因为这并不容易！

首先，我们必须在 Windows 注册表中查找最近文件的位置。首先导航到：HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\PowerPoint\User MRU

“\Office”后面的数字将根据您的版本号而有所不同，我们稍后将对此进行说明。此外，似乎大多数家庭安装都具有注册表文件夹结构，例如“\PowerPoint\User MRU\File MRU”。但是，我的组织有一个单独的嵌套文件夹，其中包含一个显然是随机的键，因此它看起来像“\User MRU[key]\File MRU”。这将在以后变得相关。

在 File MRU 文件夹中，我们将找到最多 100 个名称为“Item #”的键，以便它们从项目 1（最新）开始，一直到项目 100（最旧）。每当 PPT 将新文件保存到注册表时，它都会将现有项向下移动 1 并删除旧的项 100。

然后，我们的目标是添加一个新的注册表项作为项目 1，然后向下移动现有项，直到我们达到项目 100 的最大值。

接下来，是 Item 注册表项本身的格式设置。它们采用以下形式：

[F00000000][T0（时间戳）][O00000000]*（路径）

因此，对于我昨天（23 年 11 月 20 日）创建的文件，密钥如下所示：

[F00000000][T01DA1BFE2824E280][O00000000]*C：\测试.pptx

第一个和第三个括号中的系列在所有这些注册表项上似乎都相同，路径只是我们保存的文件名，它跟在 * 字符后面。

因此，在这一点上，让我们向后工作并弄清楚如何为新注册表项生成我们需要的字符串。这里令人沮丧的问题是时间戳，它位于一个奇怪的 Little Endian 代码中，需要大量的数学运算才能从 Now 时间生成。

幸运的是，我偶然发现了[这个][http://www.cpearson.com/excel/FileTimes.htm]很棒的资源，其中包括两个模块，它们将为我们完成数学部分。前往该链接，下载 modTimeConversionFunctions.bas 和 modGetSetFileTimes.bas 模块，并将它们导入您的 VBA 项目。

导入后，此函数将以正确的格式返回时间戳：

Public Function GetRegistryTimestamp() As String

On Error GoTo Errhandler_GetRegistryTimestamp

Dim nowFT As FileTime
Dim gmtFT As FileTime
Dim curDate As Date

Dim result As Boolean
Dim highHexString As String
Dim lowHexString As String

' For the purpose of this example, we only ever need to get right now (because this macro is only run at time of file creation).
' But you could easily add a Date variable to this function to add some flexibility.
curDate = CDate(Now)

' This will return a FILETIME date based on the Now system time
result = SerialTimeToFileTime(curDate, nowFT)
' The Now date is most likely off by a few hours, because it returns a date in local time, and we have to convert it to Greenwich Mean Time
result = LocalFileTimeToGMTFileTime(nowFT, gmtFT)

' The highDateTime and lowDateTime numbers have to be converted to Hex strings and concatenated
lowHexString = Hex(gmtFT.dwLowDateTime)
highHexString = Hex(gmtFT.dwHighDateTime)

' The leading T0 is needed for the reg key, with the hexString variables added in this order

GetRegistryTimestamp = "T0" & highHexString & lowHexString

Exit Function

Errhandler_GetRegistryTimestamp:

GetRegistryTimestamp = "error"

End Function

获取时间戳是最困难的部分。现在让我们看看如何编写一个 sub 来接收新演示文稿的文件名，并将其添加到注册表中。

下面的解决方案比我想要的更混乱，因为我遇到了两个问题。一个是我的组织在注册表中的用户 MRU 和文件 MRU 之间的唯一“密钥”需要额外的提取。

另一个是我无法弄清楚如何获取文件 MRU 文件夹中的项目计数。最多为 100 个，但在较新的安装中，文件夹中的“最近使用的项目”将少于 100 个。如果没有 Count，我无法将数组设置为正确的大小，因此我们依靠因无法提取键而产生的错误来跳出循环。

此子接受完整的文件名（filePath 变量），并将新项作为项 1 写入注册表，将其余条目向下移动列表：

Public Sub WriteFilePathToRegistry(filePath As String)

On Error GoTo Errhandler_WriteFilePathToRegistry

Dim oEnum As Object
Dim oShell As New WshShell

Dim regEntry As String

Dim timeStamp As String

Dim keyArray() As String
Dim keyCounter As Integer
Dim i As Integer
Dim fileMRUID As String
Dim regKey As String
Dim strComputer As String
Dim rPath As String
Dim arrSubKeys()
Dim strAsk
Const HKEY_CURRENT_USER = &H80000001


keyCounter = 0

' Our keyArray stores the keys currently in registry
ReDim keyArray(1 To 200)

' First we need to find out the registry folder which sits under "User MRU" in "HKCU\Software\Microsoft\Office\[ver]\PowerPoint\User MRU\

strComputer = "."
Set oEnum = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
rPath = "Software\Microsoft\Office\" & Application.Version & "\PowerPoint\User MRU\"
oEnum.EnumKey HKEY_CURRENT_USER, rPath, arrSubKeys

' We went through all that to get the folder name, because we don't know that ahead of time
fileMRUID = arrSubKeys(0)


' With the fileMRUID now known, we set up regKey, which includes the 'Item ' prefix for each key
regKey = "HKCU\" & rPath & fileMRUID & "\File MRU\Item "

' The total number of saved recent files appears limited to 100. I couldn't figure out how to pull the Count from registry, so in case the number increases, we're starting with 200
' Also note that this number will be less than 100 for any user who hasn't yet opened 100 PPT files.

For i = 1 To 200
    keyArray(i) = oShell.RegRead(regKey & CStr(i))
    ' Calling .RegRead for an item that doesn't exist causes an error. At this point we just jump out of the For loop.
    On Error GoTo exitLoop
Next

exitLoop:

' Since Item #i does not exist in the registry, we know that our keyCount is i - 1
keyCounter = i - 1
    
' We remove all those empty keys with a ReDim Preserve
ReDim Preserve keyArray(1 To keyCounter)

' This function will create a registry-friendly timestamp for Now
timeStamp = GetRegistryTimestamp

' In case of error retrieving the timestamp, we extract the timestamp from the current Item 1.
' This at least ensures our PPT file will be visible in Recents at the top of the list
If timeStamp = "error" Then
    timeStamp = ExtractTimestampFromRegKey(keyArray(1))
End If
    
regEntry = "[F00000000][" & timeStamp & "][O00000000]*" & filePath

' We want to write our regEntry to Item 1 in the registry, so that it becomes the new Most Recent item
oShell.RegWrite regKey & CStr(1), regEntry

' Then we want to shift all of the other keys down by one, excluding the i - 1 (i.e. last) item in the list
For i = 2 To keyCounter - 1
    oShell.RegWrite regKey & CStr(i), keyArray(i - 1)
Next

Exit Sub

Errhandler_WriteFilePathToRegistry:
    Debug.Print "Error " & Err.Number & " (" & Err.Description & ") in procedure WriteFilePathToRegistry, line " & Erl & "."


End Sub

您可能会注意到，我包含了一个回退，以防生成该时间戳导致错误 - 我最初的解决方案只是提取上一项 1 中的任何时间戳：

Public Function ExtractTimestampFromRegKey(regEntry As String) As String

On Error GoTo Errhandler_ExtractTimestampFromRegKey

Dim strArray() As String
Dim timeStamp As String

strArray = Split(regEntry, "][")
ExtractTimestampFromRegKey = strArray(1)

Exit Function

Errhandler_ExtractTimestampFromRegKey:
    ' If all else fails, this was the timestamp from the day I wrote this macro
    ExtractTimestampFromRegKey = "T01DA0759C9450B40"

End Function

因此，在完成所有这些操作后，以下内容将在 .另存为操作：

Public Sub TestWriteToRegistry()

Dim oPres As Presentation
Const filePath As String = "C:\test.pptx"

Set oPres = Application.Presentations.Add

' Do whatever you're doing to the new presentation.

oPres.SaveAs filePath
WriteFilePathToRegistry filePath

End Sub

上一个：在 powerpoint、excel 或 word 中列出可编辑的 ggplot

下一个：Excel VBA一直在从我的文本框中删除信息，而不是从excel中插入信息

如何使用VBA创建的新PPT演示文稿添加到最近打开的文件列表中？

How can new PPT presentations created using VBA be added to Recent Files list?

评论