ThisWorkbook.Save不会将文件保存在任何地方

Question

我正在尝试运行我在网上找到的VBA代码，以获取未读邮件并将其保存在Excel工作表中。

代码成功运行，但文件未保存在路径中，我无法在任何地方找到它。

我已删除On Error Resume Next。在ThisWorkbook.Sheets("sheet1").Range("a2:d10000").ClearContents上获取运行时错误424对象。

Sub Unread_Email_Save()

Set inboxselect = GetObject(,"Outlook.Application").GetNamespace("MAPI").PickFolder 'open up outlook folder window

If Err.Number = 91 Then 'if you cancelled the folder selection, macro will end
    MsgBox "Macro cancelled"
    Exit Sub
End If

emailcount = 0
emailcount = inboxselect.Items.Count 'max count for the selected folder

ThisWorkbook.Sheets("sheet1").Range("a2:d10000").ClearContents

For x = emailcount To 1 Step -1 'extraction starting from the most recent emails

    If Format(inboxselect.Items(x).ReceivedTime, "mm/dd/yyyy") = Format(Date, "mm/dd/yyyy") And inboxselect.Items(x).UnRead = True Then

    With inboxselect.Items(x)

            ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = .SenderName
            ThisWorkbook.Sheets(1).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Format(.ReceivedTime, "mm/dd/yyyy hh:mm AM/PM")
            ThisWorkbook.Sheets(1).Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = .Subject
            ThisWorkbook.Sheets(1).Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = .SenderEmailAddress
            ThisWorkbook.SaveAs FileName:="D:\WorkbookName1.xlsx"

    End With

    End If

Next x

End Sub