Anzeige
Archiv - Navigation
1344to1348
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Outllook - Excel nur nach Zurücksetzten möglich

Outllook - Excel nur nach Zurücksetzten möglich
11.01.2014 23:47:32
Markus
Guten Abend zusammnen,
ich bin gerade dabei ein Addin für Outlook zu schreiben. Bevor ich das ganze in Visual Studio mache, schreib ich erst einmal den ganzen Code in der Outlook VBA Umgebung.
Ich komme momentan am folgenden Problem nicht vorbei.
Mein Code exportiert die selektierte email zunächst in eine Userform, damit dort noch weiter Informationen ergänzt werden können, bevor die email dann in eine Excel Datei exportiert wird. Das klappt alles soweit auch ganz gut auch das Exportieren in Excel mit in nächste freie Zeile schreiben und so. Meine Comboboxen haben sich anfangs über den Befehl ComboBox1.AddItem gefüllt.
Das wollte ich ändern und habe den Bezug auf das zweite Tabellen Blatt gesetzt mit folgenden Code der weiter unten folgt. Nun tritt allerdings das Problem auf, dass Excel an sich noch offen bleibt, obwohl der Befehl quit gegeben wird. Das zweite Problem ist dass ich keine weitere Excel datei öffnen kann. Dies geht erst wieder wenn ich in der Outlook VBA Umgebung den "Zurücksetzen" Button betätige. Dannach kann ich wieder die Excel Dateien normal öffnen.
Ist bestimmt nur eine Kleinigkeit, allerdings sehe ich wo der fehler ist. Vielleicht findet ihr ihn ja.
Dies ist der Code für das Füllen einer Combobox:
Set xlApp = CreateObject("Excel.Application")
Dim sPfad As String
Dim sDatei As String
Dim WkBk As Workbook
Dim WkSh As Worksheet
Dim lZeile As Long
Dim UF As Object
Set UF = Export
sPfad = "C:\Users\XXX\Downloads\Excel Addin\E_Mail\"
sDatei = "Test.xlsx"
xlApp.ScreenUpdating = False
Set WkBk = Workbooks.Open(sPfad & sDatei, ReadOnly:=True)
Set WkSh = WkBk.Worksheets("Tabelle2")
For lZeile = 2 To WkSh.Cells(Rows.Count, 1).End(xlUp).Row
UF.ComboBox1.AddItem WkSh.Cells(lZeile, 1)
Next lZeile
xlApp.DisplayAlerts = False
WkBk.Saved = True ' alle Änderungen in der Eingabe-Datei verwerfen
WkBk.Close ' die Eingabe-Datei schließen
xlApp.DisplayAlerts = True
xlApp.Quit
Dies ist der restliche code falls es hilft:
In ThisOutlookSession:
Dim WithEvents myControl As CommandBarButton
Private Sub Application_Startup()                       'Addin wird bei Start von Outlook  _
gestartet
Dim oExp As Outlook.Explorer
Dim oBar As Office.CommandBar
Set oExp = Outlook.ActiveExplorer
Set oBar = oExp.CommandBars.Item("Standard")
Set myControl = oBar.FindControl(, , "Manitowoc")    'Button 1 wird definiert:
Set picPicture = LoadPicture("C:\Users\XXX\Downloads\iPhoneIcon_Big.bmp")
'____________________________________________________________________________________________
'Die Buttons werden angelegt, wenn noch nicht vorhanden:
'Button 1:
If myControl Is Nothing Then                             'Abfrage, ob Button 1 bereits  _
vorhanden ist, wenn nicht
Set myControl = oBar.Controls.Add(, , , 2, True)      'dann wird er hinzugefügt
'Vergabe der Buttoneigenschaften:
With myControl                                        'Button 1 wird angesprochen
.Caption = "XXX"                             'Name:  Name des Buttons
'.FaceId = 0                                        'Icon:  Welches Icon von den Namen  _
vorangestellt wird
.Style = msoButtonIconAndCaption                   'Style: Icon & Button sollen  _
angezeigt werden
.Visible = True                                    'Visible:  Button soll sichtbar  _
sein
.Picture = picPicture
End With                                              'Button 1 vollständig deklariert
End If                                                   'Abfrage, ob Button 1 vorhanden  _
wird beendet
End Sub
Private Sub myControl_Click(ByVal Ctrl As _
Office.CommandBarButton, CancelDefault As Boolean)
If Application.ActiveExplorer.Selection.Count > 1 Then
Call Error_Qty_Select
ElseIf Application.ActiveExplorer.Selection.Count = 1 Then
If MsgBox("Sind Sie sicher, dass Sie die ausgewählte E-Mail exportieren möchten?", vbYesNo, " _
Manitowoc Crane Care") = 6 Then
Call Excel_Aufruf
Else
Exit Sub
End If
End If
End Sub

Das sind die Module:
Sub Error_Qty_Select()
MsgBox " Sie haben mehr als eine E-Mail für den Export ausgewählt!" & Chr(10) & " Bitte nur eine E-Mail zurzeit auswählen.", vbCritical, "xxx"
End Sub 'Fehlermeldung 2: 'Anzahl markierter E-Mails > 1
'------------------------------------------------------------------------------------------
Sub Error_Choose_Empty() 'Wählen ob neue E-Mail angelegt oder in Datenbank befindliche geschloßen werden soll
MsgBox " Bitte geben Sie an, ob Sie eine neue E-Mail exportiren wollen oder eine bereits in der Datenbank befinliche geschlossen werden soll.", vbCritical, "xxx"
End Sub Sub Error_CB1_Empty() 'Krantyp wählen
MsgBox " Bitte geben Sie an auf welchen Krantyp sich diese E-Mail bezieht.", vbCritical, "xxx"
End Sub Sub Error_CB2_Empty() 'Bereich wählen
MsgBox " Bitte geben Sie an auf welchen Bereich des Kranes sich diese E-Mail bezieht.", vbCritical, "xxx"
End Sub Sub Error_CB3_Empty() 'Bereich wählen
MsgBox " Bitte stufen Sie die E-Mail bzgl. ihrer Schwere ein .", vbCritical, "xxx"
End Sub
Function Excel_vorhanden(Datei As String) As Boolean
Dim oExcel As Object
Dim oWorkSheet As Object
Dim iWorkBooks As Integer
Dim sMSG As String
On Error Resume Next
Set oExcel = GetObject(, "Excel.Application")
If oExcel Is Nothing Then
'MsgBox "Excel ist nicht gestartet"
Else
For iWorkBooks = 1 To oExcel.Workbooks.Count
Set oWorkSheet = oExcel.Workbooks(iWorkBooks)
If Not oWorkSheet Is Nothing And oWorkSheet.Name = Datei Then
Excel_vorhanden = True
Exit For
End If
Next iWorkBooks
End If
End Function Sub Excel_Aufruf()
If Excel_vorhanden("Test.xlsx") Then
MsgBox "Datei ist geöffnet"
Else
Call SetFlag
Export.Show
End If
End Sub Sub BetreffsAuslesen()
Dim objMail As MailItem ' Einzelne E-Mail
Dim bytItem As Byte ' Schleifenzähler (bis max. 255)
Dim bytItems As Byte ' Anzahl markierter E-Mails (max. 255)
'-----------------------------------------------------------------------------------------
' Programm Code
'-----------------------------------------------------------------------------------------
bytItems = ActiveExplorer.Selection.Count 'Markierte E-Mail(s) wird/werden gezählt
For bytItem = 1 To bytItems 'Schleife für markierte E-Mail(s)
Set objMail = ActiveExplorer.Selection(bytItem) 'Auswahl wird als Variable deklariert
Export.TextBox1.Text = objMail.Subject
Next 'Nächste selektierte E-Mail wird angesprochen
'-----------------------------------------------------------------------------------------
' Objektvariablen werden geleert
'-----------------------------------------------------------------------------------------
Set objMail = Nothing 'Objektvariable für markierte E-Mails wird geleert
Set olApp = Nothing 'Objektvariable für Outlook wird geleert
End Sub Sub SetFlag()
'=========================================================================================
' Setzt die Nachverfolgungsmarkierung markierter E-Mails
'=========================================================================================
'-----------------------------------------------------------------------------------------
'Deklaration der Variablen
'-----------------------------------------------------------------------------------------
Dim objMail As MailItem ' Einzelne E-Mail
Dim strRequest As String ' Text für die Kennzeichnung
Dim bytItem As Byte ' Schleifenzähler (bis max. 255)
Dim bytItems As Byte ' Anzahl markierter E-Mails (max. 255)
Dim myuser As Object ' Benutzer
Dim myNameSpace As NameSpace
Set myNameSpace = Nothing
Set olApp = CreateObject("Outlook.Application") 'Outlook als Variable
Set myuser = olApp.GetNamespace("MAPI").CurrentUser 'Benutzer wird ausgelesen
'-----------------------------------------------------------------------------------------
' Programm Code
'-----------------------------------------------------------------------------------------
bytItems = ActiveExplorer.Selection.Count 'Markierte E-Mail(s) wird/werden gezählt
For bytItem = 1 To bytItems 'Schleife für markierte E-Mail(s)
Set objMail = ActiveExplorer.Selection(bytItem) 'Auswahl wird als Variable deklariert
With objMail 'Variable wird angesprochen
'.FlagStatus = 0 'Markierungs Status: Markieung wird aufgehoben
'.FlagStatus = 1 'Markierungs Status: Erledigt
.FlagStatus = 2 'Markierungs Status: In Arbeit
'.Categories = "Geschlossen am " & Date & " von " & myuser 'E-Mail bekommt einen Vermerk
.Save 'Änderungen werden gespeichert
End With 'Variable wird freigegeben
Next 'Nächste selektierte E-Mail wird angesprochen
'-----------------------------------------------------------------------------------------
' Objektvariablen werden geleert
'-----------------------------------------------------------------------------------------
Set objMail = Nothing 'Objektvariable für markierte E-Mails wird geleert
Set olApp = Nothing 'Objektvariable für Outlook wird geleert
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Outllook - Excel nur nach Zurücksetzten möglich
12.01.2014 01:58:25
mumpel
Hallo!
Also die Codedarstelltung ist sch...lecht. Da ist nur schwer zu erkennen wo was beginnt und endet.
Mein Tipp:
Erst alles nach Excel übertragen und dort bearbeiten/nachbearbeiten.
Gruß, René

Nachtrag
12.01.2014 02:00:50
mumpel
Oder Du liest die Email aus Excel heraus auslesen. Du greift also aus Excel heraus auf die Email, liest sie aus und bearbeitest dann alles direkt in Excel.

AW: Nachtrag
13.01.2014 19:51:55
Markus
Hallo Mumpel,
sorry für den Code, bei sowas würd mir auch die Lust vergehen.
Ich habe mittlerweile meinen Fehler gefunden. Dieser Code hat verhindert das vba vollständig beendet werden konnte. Nachdem ich ihn entfernt habe lief alles bestens.
Private Sub userform_activate()
Datum.Caption = Date
Do
DoEvents
Uhrzeit.Caption = Time
Loop
End Sub
Gruß Markus
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige