Excel-Fenster in den Vordergrund
Uppe
ich öffne aus Excel heraus eine Outlook-Session und ein zweites Excel-Fenster, um Mailadressen zu verarbeiten.
Dabei ist das Outlookfenster im Vordergrund und ich bekomme es nicht wieder weg. Auch Thisworkbook.Activate hilft nichts.
Wie kann ich erreichen, dass nach Beendigung der Verarbeitung der Mailadressen wieder mein Workbook zu sehen ist?
Mein Code:
Public Sub SmcVerteilerErweitern()
'Deklaration
Dim OutApp As Object
Dim nspMapi As Object
Dim folMapi As Object
Dim itmAll As Object
Dim itmReal As Object
Dim itmDistList As Object
Dim strContactFilter As String
Dim excApp As Object
Dim excWkb As Object
Dim excWks As Object
Dim intRow As Integer
Dim i As Integer
Dim strName As String
Set OutApp = CreateObject("Outlook.Application")
'Outlook-Objekte öffnen
Set nspMapi = OutApp.GetNamespace("MAPI")
'Set folMapi = nspMapi.GetDefaultFolder(olFolderContacts)
'Ordner auswählen
Set folMapi = nspMapi.Folders.Item("Public Folders").Folders.Item("....
Set itmAll = folMapi.Items
'nur Verteilerlisten verwenden
strContactFilter = "[MessageClass] = 'IPM.Distlist'"
Set itmReal = itmAll.Restrict(strContactFilter)
'Excel-Objekte öffnen
Set excApp = CreateObject("Excel.Application") 'Neue Excel-Instanz
Set excWkb = excApp.Workbooks.Add 'Neues Workbook anlegen
Set excWks = excWkb.Sheets(1) 'Erstes Sheet
'Excel-Worksheet aufbereiten
With excWks
'Outlook-Verteilerliste nach Excel übertragen
intRow = 1
.Range("A1") = strEmpfänger
##VERARBEITUNG##
strEmpfänger = .Range("B1")
For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
strEmpfänger = strEmpfänger & "; " & .Range("B" & i).Value
Next i
End With
excWkb.Close False
'Speicher freigeben
Set itmReal = Nothing
Set itmAll = Nothing
Set folMapi = Nothing
Set nspMapi = Nothing
Set excWks = Nothing
Set excWkb = Nothing
Set excApp = Nothing
End Sub
Uppe