Office: Outlook im Vordergrund anzeigen/einblenden

Hallo ihr lieben,

ich hab mir folgendes Makro zusammen gebastelt was auch soweit funktioniert, nur leider wird Outlook, wenn es schon minimiert geöffnet ist, nicht in den Vordergrund maximiert. *frown.gif*


Public Sub Bild_kopieren_Outlook_oeffnen()

Dim bild As Object
Range("A1:J38").Copy
Set bild = ActiveSheet.Pictures.Paste
bild.Cut

Dim objWMI As Object, objProc As Object, objShell As Object
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!" _
& "." & "rootcimv2")
Set objProc = objWMI.ExecQuery("Select * from Win32_Process " & _
"Where Name = 'OUTLOOK.EXE'")
If objProc.Count = 0 Then
Set objShell = CreateObject("WScript.Shell")
objShell.Run "OUTLOOK"
End If
Set objWMI = Nothing
Set objProc = Nothing
Set objShell = Nothing

ActiveWorkbook.Save
Application.WindowState = xlMinimized
ActiveWorkbook.Close

End Sub


wer hat eine Idee wie man Outlook maximiert in den Vordergrund bekommt wenn es schon geöffnet ist?
danke

als kleines i-Tüpfelchen hab ich noch das Problem, dass sich zwar das aktive Excelblatt schließt aber dann ein graues Excelfenster noch offen bleibt. Wie kann man dieses noch mit schließen ohne das weitere Excelfenster, welche auch noch im Hintergrund geöffnet sind, nicht mit geschlossen werden? Es soll eigentlich nur das eine Excelfenster in welchen das Makro ausgeführt wird geschlossen werden!

:)

 

Hallo,

könnte frau googlen ...
Code:

 

Danke "Flotter Feger" :-)

...aber Frau hat gegoogelt und auch vieles gefunden, aber da ich nur ein Copy-Paste-Worker bin schaffe ich es dieses mal nicht den Code in mein Macro ein zu fügen :-/
Dein Code funktioniert nur wenn Outlook schon geöffnet ist, wenn Outlook geschlossen ist bekomme ich einen "Laufzeitfehler '429': Objektdarstellung durch ActiveX-Komponente nicht möglich" auf Zeile: "Set olObj = GetObject(, "Outlook.Application")"

Code:

Anne

 

Hallo Annemarie,

Was hast du denn mit Outlook am Schluss genau vor ?

Es geht dir doch nicht nur um Öffnen oder Maximieren ... und da brauch ich noch nicht mal meine weibliche Intuition dazu ... *tongue.gif*

Erzähl doch mal ...


PS:
cooles Bustier ...

 

Also...
...wie du sehen kannst wird mit dem Makro ein Zellenbereich als Bild in den Zwischenspeicher kopiert, dieses Bild wird in Outlook in eine bestimmte vorhandene Mail kopiert und mit zusätzlichen Bemerkungen versendet!
Die Schritte in Outlook sind immer gleich: zu diesem bestimmten Thema die zuletzt gesendete Email suchen, öffnen, diese Nachricht erneut senden, Betreff aktualisieren, Bemerkung im Textfeld aktualisieren, das vorhandene Bild mit dem aus dem Zwischenspeicher ersetzen und Mail senden.

 

Die Mail könnte bestimmt auch aus Excel heraus mit einem Makro erstellt werden....aber ich wollte erstmal klein anfangen :-)
Die Mail ist immer wie folgend aufgebaut:

Code:

 

Hallo Anne,

es ist 100mal einfacher die Mail komplett neu zu erstellen.

Wäre das eine Option für dich?

 

Hallo Anne,

eventuell so ...
Code:

 

*boah..dein Makro hat bei mir eine Endlosschleife ausgelöst und innerhalb einer Minute 100mal Outlook geöffnet...ich musste meinen Rechner neu starten um das zu beenden...ich mag es nicht nochmal ausprobieren *nene

@Nebumuk: es wäre nur einfacher die Mail aus Excel heraus mit VBA neu zu erstellen, aber das bekomme ich momentan nicht hin.

 

Hallo Annemarie,

im Prinzip so:

Option Explicit

Public Sub CreateMail()
Dim objOutlook As Object, objMail As Object
Dim strTemp As String

strTemp = "TextTextText" & Range("E1").Value & "TextTextText" & "<br><br>"
strTemp = strTemp & "Bemerkung: " & "<br><br>"
strTemp = strTemp & Range("D5").Value & "<br>"
strTemp = strTemp & ">Link aus Excel E5<" & "<br><br>" '??????????????????????????
strTemp = strTemp & Range("D6").Value & "<br>"
strTemp = strTemp & ">Link aus Excel E6<" & "<br><br>" '??????????????????????????
strTemp = strTemp & Range("D7").Value & "<br>"
strTemp = strTemp & ">Link aus Excel E7<" & "<br><br>" '??????????????????????????
strTemp = strTemp & RangeToHTML(ActiveSheet.Name, "A1:J38")

Set objOutlook = CreateObject(Class:="Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "Empfänger@Porvider.de"
.Subject = "Betreff"
.HtmlBody = strTemp
.Display 'Mail anzeigen
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub

Private Function RangeToHTML(ByVal pvstrWorksheetName As String, ByVal pvstrRangeAddress As String) As String
Const ForReading As Long = 1
Const TristateUseDefault As Long = -2
Dim objFileSystemObject As Object, objFile As Object
Dim objTextStream As Object, objPublishObject As PublishObject
Dim strPath As String
strPath = Environ$("Tmp") & "Mail_" & Format$(Now, "dd-mm-yyyy_Hh-Nn-Ss") & ".htm"
Set objPublishObject = ThisWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strPath, _
Sheet:=pvstrWorksheetName, _
Source:=pvstrRangeAddress, _
HtmlType:=xlHtmlStatic)
Call objPublishObject.Publish(Create:=True)
Set objFileSystemObject = CreateObject(Class:="Scripting.FileSystemObject")
Set objFile = objFileSystemObject.GetFile(strPath)
Set objTextStream = objFile.OpenAsTextStream(iomode:=ForReading, Format:=TristateUseDefault)
RangeToHTML = objTextStream.ReadAll
RangeToHTML = Replace(Expression:=RangeToHTML, Find:="align=center x:publishsource=", _
Replace:="align=left x:publishsource=")
objTextStream.Close
Call Kill(PathName:=strPath)
Set objTextStream = Nothing
Set objFile = Nothing
Set objFileSystemObject = Nothing
Set objPublishObject = Nothing
End Function

Das mit den Links musst du mir noch genauer erklären.

 

WOW*boah ich bin begeistert!!! ...das ist ja schon fast perfekt! :-)
dankeschön

Mit Links meine ich eine Verlinkung aus einer Zelle, sollte also eine Adresse beim drauf klicken aufrufen, der Screenshot im Anhang hilft dir da sicher weiter.

Im Betreff muss der Inhalt aus Zelle J2 eingefügt werden, in meinem Fall ist das ein Datum (nicht das aktuelle). Nachtrag 23:15Uhr: selbst hin bekommen (stolz bin :-)

Der Zellbereich A1:J38 muss als Grafik in die Email eingefügt werden, wenn möglich auch linksbündig. (Da auf dem Handy von meinem Chef Tabellen unübersichtlich und verschachtelt in der Emailapp dargestellt werden)
Das kopieren in den Zwischenspeicher hat problemlos mit diesem Code funktioniert:
Dim bild As Object
Range("A1:J38").Copy
Set bild = ActiveSheet.Pictures.Paste
bild.Cut
und da müsste es nur eine Funktion geben das der Zwischenspeicher ausgelesen und in die Email kopiert wird (eigentlich Rechtsklick > Kontexmenü > Einfügen Grafik)

@Flotter Feger: dir auch erstmal vielen lieben Dank

 

Hallo Annemarie,

befindet sich der Bereich welcher als Bild eingefügt werden soll in einer anderen Tabelle?

 

ohoh*entsetzt auf Win7 Rechner kommt ein Laufzeitfehler *eek.gif*
gestern Abend zu Hause auf Win10 lief es ohne Probleme! *depressed ...die Officeversion ist glaube ich die gleiche! :-/
siehe Anhang

der Zellbereich welcher als Bild eingefügt werden soll befindet sich im gleichen Tabellenblatt, wie auch alle anderen Informationen welche an Email übergeben werden!

 

Hallo Anne,

das ist egal, ich musste das Konzept sowieso ändern.

Teste mal:

Option Explicit

Public Sub CreateMail()

Dim objOutlook As Object, objMail As Object
Dim objWord As Object
Dim strLinks(5) As String

With Range("E5").Hyperlinks(1)
strLinks(0) = .Address
strLinks(1) = .TextToDisplay
End With
With Range("E6").Hyperlinks(1)
strLinks(2) = .Address
strLinks(3) = .TextToDisplay
End With
With Range("E7").Hyperlinks(1)
strLinks(4) = .Address
strLinks(5) = .TextToDisplay
End With

Call Range("A1:J38").CopyPicture

Set objOutlook = CreateObject(Class:="Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With objMail
.BodyFormat = 2
.To = "Empfänger@Porvider.de"
.Subject = Range("J2").Text
Call .Display
Set objWord = .GetInspector.WordEditor.Application
With objWord
Call .Selection.TypeText(Text:="texttexttext" & Range("E1").Text & "TextTextText")
Call .Selection.TypeParagraph
Call .Selection.TypeParagraph
Call .Selection.TypeText(Text:="Bemerkung: ")
Call .Selection.TypeParagraph
Call .Selection.TypeParagraph
Call .Selection.TypeText(Text:=Range("D5").Text)
Call .Selection.TypeParagraph
Call .Documents(1).Hyperlinks.Add(Anchor:=.Selection.Range, Address:= _
strLinks(0), TextToDisplay:=strLinks(1))
Call .Selection.TypeParagraph
Call .Selection.TypeParagraph
Call .Selection.TypeText(Text:=Range("D6").Text)
Call .Selection.TypeParagraph
Call .Documents(1).Hyperlinks.Add(Anchor:=.Selection.Range, Address:= _
strLinks(2), TextToDisplay:=strLinks(3))
Call .Selection.TypeParagraph
Call .Selection.TypeParagraph
Call .Selection.TypeText(Text:=Range("D7").Text)
Call .Selection.TypeParagraph
Call .Documents(1).Hyperlinks.Add(Anchor:=.Selection.Range, Address:= _
strLinks(4), TextToDisplay:=strLinks(5))
Call .Selection.TypeParagraph
Call .Selection.TypeParagraph
Call .Selection.Paste
Call .Selection.TypeParagraph
Call .Selection.TypeParagraph
Call .Selection.TypeText(Text:="Gruß")
Call .Selection.TypeParagraph
Call .Selection.TypeText(Text:="Annemarie")
Call .Selection.HomeKey(Unit:=6)
End With
End With
Set objWord = Nothing
Set objMail = Nothing
Set objOutlook = Nothing
End Sub

 

*boah *boah *boah
das gibt´s doch nicht!!!!! ...wie machst du das so schnell??? ...und vor allem >> es funktioniert wieder auf Anhieb!!!! ...ich könnte dich *knuddel

wie könnte ich jetzt noch alles in Arial 12 darstellen und Wörter in FETT?
mal sehn ob ich das auch selbst hinbekomme!

großes DANKESCHÖN @Nepumuk *top