Question

我不小心删除了我的电子邮件帐户，因此删除了该帐户中的所有电子邮件。是否有机会恢复电子邮件？我该如何恢复？谢谢。

Answer 1

四个月前，我本来会同意Om3r的评论，提供Outlook商店的位置。但是我在12月买了一台新笔记本电脑，现在Outlook文件不在所有文档都说的应有的位置。更糟糕的是，尽管可以通过VBA找到包含Outlook文件的文件夹，但我无法使用“文件资源管理器”找到它们。

下面的宏在驱动器C中搜索具有OST或PST扩展名的文件。我不能保证此宏会找到您丢失的存储，但是，如果仍在光盘上，它将找到它。如果找到丢失的商店，则可能必须使用VBA将其移动到可访问的位置。

将下面的宏复制到启用了宏的工作簿中并运行它。运行时，活动工作表将如下所示：

1923 Folders to search
 327 Folders searched           

     Store       Size      Date Folder
     $ILJARJ0.pst   212   28Mar20 C:\$Recycle.Bin\S-1-5-21-3957073674-21115239-22921093-1001
     $IMS96DJ.pst   212   28Mar20 C:\$Recycle.Bin\S-1-5-21-3957073674-21115239-22921093-1001

前两行给出了粗略的进度指示器。在我的笔记本电脑上，例程以69190个搜索到的文件夹结束。我不知道为什么我的回收站中有PST文件。 3月28日，我没有做任何相关的事情。例程完成后，将为找到的宏的每个商店提供自动调整的列表。在我的笔记本电脑上，没有什么是我期望的，有些是重复的。希望您能找到您的商店。

Option Explicit
Sub SearchForStoresOnC()

  ' Searches drive C for files with an extension of PST or OST
  ' Warning: overwrites the active workbook

  Dim ErrNum As Long
  Dim FileAttr As Long
  Dim FileName As String
  Dim FldrName As String
  Dim RowCrnt As Long
  Dim ToSearch As Collection

  Cells.EntireRow.Delete
  Range("A1").Value = 0
  Range("A2").Value = 0
  Range("B1").Value = "Folders to search"
  Range("B2").Value = "Folders searched"
  Range("B4").Value = "Store"
  With Range("C4")
    .Value = "Size"
    .HorizontalAlignment = xlRight
  End With
  With Range("D4")
    .Value = "Date"
    .HorizontalAlignment = xlRight
  End With
  Range("E4") = "Folder"
  RowCrnt = 5

  Set ToSearch = New Collection
  ' Load ToSearch with drive to search.
  ToSearch.Add "C:"

  Do While ToSearch.Count > 0

    FldrName = ToSearch(1)
    ToSearch.Remove 1

    Err.Clear
    ErrNum = 0
    On Error Resume Next
    ' Stores are unlikely to be hidden but can be in folders that are hidden
    FileName = Dir$(FldrName & "\*.*", vbDirectory + vbHidden + vbSystem)
    ErrNum = Err.Number
    On Error GoTo 0
    If ErrNum <> 0 Then
      'Debug.Print "Dir error: " & FldrName
    Else
      Do While FileName <> ""
        If FileName = "." Or FileName = ".." Then
          ' Ignore pointers
        Else
          Err.Clear
          On Error Resume Next
          FileAttr = GetAttr(FldrName & "\" & FileName)
          ErrNum = Err.Number
          On Error GoTo 0
          If ErrNum = 0 Then
            ' Ignore file and folders which give errors
            If (FileAttr And vbDirectory) = 0 Then
              ' File
              'Debug.Assert False
               Select Case Right$(FileName, 4)
                 Case ".pst", ".ost"
                 Cells(RowCrnt, "B").Value = FileName
                 With Cells(RowCrnt, "C")
                   .Value = FileLen(FldrName & "\" & FileName)
                   .NumberFormat = "#,##0"
                 End With
                 With Cells(RowCrnt, "D")
                   .Value = FileDateTime(FldrName & "\" & FileName)
                   .NumberFormat = "dmmmyy"
                 End With
                 Cells(RowCrnt, "E").Value = FldrName
                 RowCrnt = RowCrnt + 1
               End Select
            Else
              ' Directory
              ToSearch.Add FldrName & "\" & FileName
            End If  ' File or Directory
          Else
            'Debug.Print "FileAttr error: " & FldrName & "\" & FileName
          End If  ' FileAttr does not give an error
        End If ' Pointer or (File or Directory)
        FileName = Dir$
      Loop  ' For each pointer, file and sub-directory in folder
    End If  ' Dir$ gives error

    Range("A1") = ToSearch.Count
    Range("A2") = Range("A2") + 1
    DoEvents

  Loop  'until ToSearch empty

  Columns.AutoFit

End Sub

如何为已删除的电子邮件帐户恢复Outlook电子邮件

1 个答案: