我曾尝试使用此VBA代码，但Shellexecute它只工作时，我进入它使用F8的步骤，它打开文件，以便Outlook可以读取它。但是，当我按F5它不打开文件，所以给出错误的Set MyItem = Myinspect.CurrentItem。
这里睡眠是没有用的，因为电子邮件根本没有被打开。基本上我特灵重命名.eml文件后提取其接收时间.

#If VBA7 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2
Sub AgregarFechaEnvioACarpetas()
    Dim rutaCarpeta As String
    Dim carpeta As Object
    Dim archivo As Object
    Dim nombreArchivo As String
    Dim fechaEnvio As Date
    
    rutaCarpeta = "C:\Users\MBA\Desktop\PDFs\MyEmails\"

    
    Set carpeta = CreateObject("Scripting.FileSystemObject").GetFolder(rutaCarpeta)
    
    For Each archivo In carpeta.Files
        If LCase(Right(archivo.name, 4)) = ".eml" Then
            
            If Dir(archivo.Path) = "" Then
                MsgBox "File " & archivo.Path & " does not exist"
            Else
                ShellExecute 0, "Open", archivo.Path, "", archivo.Path, SW_SHOWNORMAL
            End If
            
            Sleep 5000

            fechaEnvio = GetFechaEnvioEml(archivo.Path)
            
            'nombreArchivo = archivo.name & "_" & Format(fechaEnvio, "ddmmyyyy")
            'Correction made for the right name
            nombreArchivo = Left(archivo.name, Len(archivo.name) - 4) & "_" & Format(fechaEnvio, "ddmmyyyy") & ".eml"
            
            archivo.name = nombreArchivo
        
        End If
    Next archivo
    
    MsgBox "Proceso completado."
End Sub

Function GetFechaEnvioEml(rutaArchivo As String) As Date

    Dim objOL As Object
    Dim objMail As Object
    
    Set objOL = CreateObject("Outlook.Application")
        
        Set Myinspect = objOL.ActiveInspector
        Set MyItem = Myinspect.CurrentItem
    
    GetFechaEnvioEml = MyItem.ReceivedTime
    
    MyItem.Close olDiscard
    Set MyItem = Nothing
    Set objOL = Nothing

End Function