Hey Leute,

ich habe vor mir ein Makro in Outlook zu bauen um eine Copy Paste Aufgabe auszuführen. Dafür habe ich mir aus ein paar anderen Codes etwas zusammen kopiert. Soweit ist es schon mal möglich, dass er mir das Empfangsdatum der Emails, deren Ordner ich auswähle, in eine Exceltabelle kopiert. Für die Emails für die das Script jedoch gedacht es funktioniert es nicht. Hier bekomme ich den Fehlercode 13. Der Unterschied zwischen den beiden Mailtypen besteht darin, dass die Mails, die ich bearbeiten will automatisch erstellt sind. Meine Vermutung ist, dass es etwas mit den Mailattributen zu tun hat:

Mails bei denen es funktioniert haben ein "Gesendet" und "An" Feld. Mails bei denen es nicht klappt jedoch sind nur die Felder "Unterhaltung", "Bereitgestellt am" und "Bereitgestellt in" vorhanden.

Könnt ihr mir vielleicht helfen, wo der Fehler im Script ist?

Option Explicit

Sub Bestellungen()
  On Error GoTo ErrHandler
  Dim appExcel As Excel.Application
  Dim wkb As Excel.Workbook
 
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim strSheet As String
Dim strPath As String
Dim intRowCounter As Integer
Dim intColumnCounter As Integer
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object

Dim i As Long   ' findet die Anfangs-Position im Text
Dim j As Long   ' findet die End-Position im Text
Dim f As String ' Firma
Dim n As String ' Name
Dim s As String ' Straße
Dim o As String ' Ort


strSheet = "OutlookItems.xlsx"
strPath = "Z:\Benutzer\04_Personen\Florian Hahn\"
strSheet = strPath & strSheet
Debug.Print strSheet

  'Select export folder
 
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder

  'Handle potential errors with Select Folder dialog box.

If fld Is Nothing Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
ElseIf fld.Items.Count = 0 Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
End If

  'Open and activate Excel workbook.

Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
appExcel.Application.Visible = True

  'Copy field items in mail folder.

For Each itm In fld.Items
intColumnCounter = 1
Set msg = itm
intRowCounter = intRowCounter + 1
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.ReceivedTime
Next itm


  Set appExcel = Nothing
  Set wkb = Nothing

Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing

  Exit Sub

ErrHandler:  If Err.Number = 1004 Then
MsgBox strSheet & " doesn't exist", vbOKOnly, _
"Error"
Else
MsgBox Err.Number & "; Description: ", vbOKOnly, _
"Error"
End If

Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing


End Sub