VBA Email extract problem

[Liverlee]

I have two sheets, one labeled macro and the other sheet2. I'm trying to extract from Outlook the Date the email was sent, the sender name, sender email, subject matter, if the email has attachments and the body of message. I have six columns in sheet2 labeled Received, Sender, Sender Email, Subject, Attachments and Body.

The code I'm using in VBA is

Sub Refresh_All()

With Sheet2
 
.Lbl_Mailbox.Caption = "None"
.Lbl_MailboxMoveto.Caption = "None"

End With

End Sub

Function ExtractAllDates(ByVal strfolder As String)

Dim OlApp As Object
Dim Nmsp As Object
Dim OlItems As Object
Dim OlFolder As Object
Dim OlFolderMove As Object
Dim OlMail As Object
Dim i As Integer
Dim myFlNm   As String
Dim myExt As String
Dim strFullFlNm As String
Dim MoveSubFolder As Object
Dim ExtractionDone  As Boolean
Dim strMLBx() As String
Dim strExtractionSumm As String
Dim totEmailsExtracted As Long
Dim LastRow As Long
Dim LastRow2 As Long
Dim response As String
Dim j As Long
Dim strSender As String
Dim msgbody As String
Dim Sht1Nm As String
Dim Sht2Nm As String
Dim strSub As String
Dim strDt As String

Sht1Nm = "Outlook"
Sht2Nm = "Outlook2"

'HABILITANDO OUTLOOK LISTO
On Error Resume Next
Set OlApp = GetObject(, "Outlook.Application")

If Err.Number = 429 Then
    Set OlApp = CreateObject("Outlook.application")
End If

Set Nmsp = OlApp.getnamespace("MAPI")

'OBTENIENDO MAILBOX Y SUB FOLDERS
strMLBx = VBA.Split(Sheet2.Lbl_Mailbox.Caption, ">>")
Select Case UBound(strMLBx)
Case 0
    Set OlFolder = Nmsp.Folders(strMLBx(0))
Case 1
    Set OlFolder = Nmsp.Folders(strMLBx(0)).Folders(strMLBx(1))
Case 2
    Set OlFolder = Nmsp.Folders(strMLBx(0)).Folders(strMLBx(1)).Folders(strMLBx(2))
Case 3
    Set OlFolder = Nmsp.Folders(strMLBx(0)).Folders(strMLBx(1)).Folders(strMLBx(2)).Folders(strMLBx(3))
Case 4
    Set OlFolder = Nmsp.Folders(strMLBx(0)).Folders(strMLBx(1)).Folders(strMLBx(2)).Folders(strMLBx(3)).Folders(strMLBx(4))
Case 5
    Set OlFolder = Nmsp.Folders(strMLBx(0)).Folders(strMLBx(1)).Folders(strMLBx(2)).Folders(strMLBx(3)).Folders(strMLBx(4)).Folders(strMLBx(5))
Case 6
    Set OlFolder = Nmsp.Folders(strMLBx(0)).Folders(strMLBx(1)).Folders(strMLBx(2)).Folders(strMLBx(3)).Folders(strMLBx(4)).Folders(strMLBx(5)).Folders(strMLBx(6))
End Select
'Set strMLBx = Nothing

If Err.Number = -2147221233 Then
    MsgBox "Invalid Mailbox", vbCritical
    Exit Function
End If

With ThisWorkbook.Sheets(Sht1Nm)
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

With ThisWorkbook.Sheets(Sht2Nm)
    LastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

response = MsgBox("Would you like to clear existing data in ""Outlook"" sheet ?", vbYesNo + vbCritical + vbDefaultButton2, "Clear Existing records ?")
If response = vbYes Then
    With ThisWorkbook.Sheets(Sht1Nm)
        .Range("A2:F" & LastRow).ClearContents
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    
    With ThisWorkbook.Sheets(Sht2Nm)
        .Range("A2:F" & LastRow2).ClearContents
        LastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
End If

Set OlItems = OlFolder.Items
OlItems.Sort "[ReceivedTime]"

'LOOP
 For j = OlItems.Count To 1 Step -1
        DoEvents
        
        Set OlMail = OlItems(j)
        
            If OlMail.Sender <> "" Then
                strSender = OlMail.Sender
            ElseIf OlMail.sendername <> "" Then
                strSender = OlMail.sendername
            ElseIf OlMail.SenderEmailAddress <> "" Then
                strSender = OlMail.SenderEmailAddress
            End If
            
            strSub = OlMail.Subject
            msgbody = OlMail.Body
            strDt = VBA.Format(OlMail.RECEIVEDTIME, "ddd dd/mm/yyyy hh:mm")

            With ThisWorkbook.Sheets(Sht1Nm)
                .Cells(LastRow, "A") = strSender
                .Cells(LastRow, "B") = strSub
                .Cells(LastRow, "C") = strDt
                .Cells(LastRow, "D") = strSub
                .Cells(LastRow, "E").Value = IIf(hasAttachments, "True", "False")
                .Cells(LastRow, "F") = msgbody
                 LastRow = LastRow + 1
            End With
        totEmailsExtracted = totEmailsExtracted + 1
  
    Next j

Set OlFolder = Nothing
Set OlItems = Nothing
Set OlMail = Nothing
Set OlApp = Nothing

If totEmailsExtracted = 0 Then
    MsgBox "No Data Found in selected mailbox", vbInformation
Else
    MsgBox "Total Emails Extracted :=" & totEmailsExtracted, vbInformation
     ThisWorkbook.Sheets("Outlook").Select
End If

End Function

When I try to run I get an error code for .Lbl_MailboxMoveto.Caption

Any help appreciated