PDA

Vollständige Version anzeigen : Die Anzahl der gleichzeitig geöffneten Elemente wurdeüberschritten


Michael Bayer
08.07.2014, 08:15
Ich war schon länger nicht mehr hier. Auch sind meine Fähigkeiten mit VBA nicht sehr gut. Jedoch habe ich schon das eine oder andere geschafft.

Habe ein Programm geschrieben, welches Wartungsaufgaben aus einem öffentlichen Ordner unseres Exchange Servers ausließt und in Excel ablegt. Nun hat die Firma welche uns den Exchange betreut eine Beschränkung ein gebaut. Mehr als 250 Elemente dürfen nicht gleichzeitig geöffnet werden.
Es handelt sich um einen Exchange 2013 Server.

jetzt beginnt mein Problem. In diesem öffentlichen Aufgabenordner liegen rund 5000 Aufgaben.
Eine Variable habe ich geschaffen, welche die Anzahl der Durchläufe berechnet. Jedoch wie krieg ich das jetzt hin, dass er mir die ersten 249 Aufgaben ausließt und dann die nächsten, ... und sofort bis er zum letzten Durchlauf kommt.
Habe das ganze in Visual Studio 2013 geschrieben. aber hier mal der Code:
Imports Excel = Microsoft.Office.Interop.Excel
Imports Outlook = Microsoft.Office.Interop.Outlook
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

End Sub
Sub GetOLTasks(ByVal sender, ByVal e)
Dim OL As Outlook.Application = New Outlook.Application()
Dim objFolder As Outlook.MAPIFolder = Nothing
Dim objSubFolder As Outlook.MAPIFolder = Nothing
Dim objTask As Outlook.TaskItem
Dim mySubFolder As Outlook.MAPIFolder = Nothing
Dim i As Long = 1
Dim T As Long = 0 'T ist die Anzahl Der Durchläufe, bis alle Aufgaben eingelesen sind.
Dim Ti As Long = 0 'Ti ist der Zähler.
Dim excApp As Excel.Application = New Excel.Application()
Dim excWorkbook As Excel.Workbook = Nothing
Dim fname As String = "Z:\OutlookAufgabenHaid.xlsx"
Dim foldername As String = "Wartung-Haid"
Dim mystr As String = vbNullString
Dim summetasks As Integer = 0
Dim L


On Error GoTo Fehler
If Not chkhaid.Checked Then
fname = Replace(fname, "Haid", "Kaplice")
foldername = Replace(foldername, "Haid", "Kaplice")
End If
cmdMakeOLTasks.Enabled = False

For Each folder In OL.GetNamespace("MAPI").Folders
If InStr(folder.name, "ffentliche") > 0 Then
objFolder = OL.GetNamespace("MAPI").Folders(folder.name)
End If
Next

If Not objFolder Is Nothing Then
For Each folder In objFolder.Folders
If InStr(folder.name, "ffentliche") > 0 Then
objSubFolder = objFolder.Folders(folder.name)
End If
Next
End If

If Not objSubFolder Is Nothing Then mySubFolder = objSubFolder.Folders(foldername)

excWorkbook = excApp.Workbooks.Add
excApp.Visible = False
Dim objSheet = excWorkbook.Sheets("Tabelle1")
With objSheet
.Cells(1, 1).value = "Aufgabe"
.Cells(1, 2).value = "Start"
.Cells(1, 3).value = "Fällig"
.Cells(1, 4).value = "Status"
End With

summetasks = mySubFolder.Items.Count
progBar.Maximum = summetasks
progBar.Value = 0
T = summetasks / 249

For L = 0 To T Step 1
objTask.In mySubFolder.Items

With objSheet

If objTask.Status <> 2 Then 'OL.olTaskComplete =2

i = i + 1
.Cells(i, 1) = objTask.Subject
.Cells(i, 2) = objTask.StartDate
.Cells(i, 3) = objTask.DueDate
Select Case objTask.EntryID
End Select
Select Case objTask.Status
Case 4 : .Cells(i, 4) = "Zurückgestellt" 'OL.olTaskDeferred
Case 1 : .Cells(i, 4) = "In Bearbeitung" 'OL.olTaskInProgress
Case 0 : .Cells(i, 4) = "Nicht begonnen" 'OL.olTaskNotStarted
Case 3 : .Cells(i, 4) = "Wartend" 'OL.olTaskWaiting
Case Else
End Select
End If
End With

Next L






progBar.Value += 1

' Next objTask

excApp.Range("A1:D1").Font.Bold = True
Dim af = objSheet.Range("A:D").AutoFilter()
excApp.Columns("A:D").EntireColumn.AutoFit()

excApp.DisplayAlerts = False
excWorkbook.SaveAs(fname)
excApp.DisplayAlerts = True
excWorkbook.Saved = True
excWorkbook.Close()
excApp.Quit()
Process.Start(fname)
Call cmdExit_Click(sender, e)
Ende:
cmdMakeOLTasks.Enabled = True
objFolder = Nothing
objTask = Nothing
objSheet = Nothing
excWorkbook = Nothing
excApp = Nothing
OL = Nothing

Exit Sub
Fehler:
MsgBox(Err.Description)
Resume Ende
End Sub

Private Sub cmdMakeOLTasks_Click(sender As Object, e As EventArgs) Handles cmdMakeOLTasks.Click
Call GetOLTasks(sender, e)
End Sub

Private Sub cmdExit_Click(sender As Object, e As EventArgs) Handles cmdExit.Click
Me.Close()
End Sub
End Class
Kann mir wer helfen?

Nepumuk
08.07.2014, 09:23
Hallo,

warum schließt du die TaskItems nicht einfach nach dem auslesen?

objTask.Close

Michael Bayer
08.07.2014, 10:23
Habe ich Dich richtig verstanden du meinst ich solles Laufen lassen wie es war so mit for Each objtask............. und vor dem Next obltask.close einfügen?

Werde ich versuchen. Aber schon mal Danke für den Tip.
Melde mich wieder.

Michael Bayer
08.07.2014, 10:52
habe objtask.close vor dem Next eingegeben. Aber leider funktioniert es doch noch nicht. denn dann steht objtask.close (). Bekam eine Fehlermeldung, die besagt das eine Anweisung nötig ist. habe in die Klammer fname eingegeben. Dachte das wäre richtig aber doch nicht ganz.