Enviar correo electrónico con archivos adjuntos ubicados en la misma carpeta que el libro de trabajo.

Genero un correo electrónico en formato HTML de Outlook para enviar a la dirección de correo electrónico designada por la celda.

Adjunto varios archivos ubicados en la misma carpeta que el libro de trabajo con el cuadro de diálogo FileDialog.
Me gustaría que la carpeta inicial que aparezca sea la ubicación del libro de trabajo actual.

Private Sub CommandButton1_Click()
    Dim xStrFile As String
    Dim xFilePath As String
    Dim xFileDlg As FileDialog
    Dim xFileDlgItem As Variant
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    Application.ScreenUpdating = False
    Set xOutApp = CreateObject("Outlook.Application")
    Set xMailOut = xOutApp.CreateItem(olMailItem)
    Set xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
    If xFileDlg.Show = -1 Then
        With xMailOut
            .Display
            .To = Range("C14").Value
            .Subject = Range("B6").Value & " " & Range("B7").Value & " - " & Range("B9").Value & " Estimación de Azulejo"
            .HTMLBody = Range("B14").Value & "," & "<br>" & vbCrLf & "Aquí está nuestra estimación de azulejos para el proyecto de" & Range("B6").Value & " " & Range("B7").Value & " - " & Range("B9").Value & ". Por favor, responda a este correo electrónico para confirmar que ha recibido la propuesta." & .HTMLBody
            For Each xFileDlgItem In xFileDlg.SelectedItems
                .Attachments.Add xFileDlgItem
            Next xFileDlgItem
            .Display
        End With
    End If
    Set xMailOut = Nothing
    Set xOutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Private Sub CommandButton3_Click()

End Sub