Archive for the ‘Makro’s’ Category

Outlook 2003 – Eingebette Bilder aus Mails exportieren

Mittwoch, Juli 14th, 2010

Um im Outlook 2003 in Mails eingebettete Bilder  alle in einem Schwung im JPG Format abzuspeichern bietet sich folgende Skript an das ich bei  auf planet-outlook.de gefunden habe. Das Original Skript der Website hab ich etwas umgebaut und angepasst. Der Export Ordner ist nun nicht mehr statisch sondern kann per Dialogbox individuell ausgewählt werden!

Hier das Skript:

Sub Eingebettete_Bilder_Speichern()

Dim objMail As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment

Dim AppShell As Object
Dim BrowseDir As Variant

Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)

On Error Resume Next

strImgPath = BrowseDir.Items().Item().Path & "\"
If Right(strImgPath, 1) <> "" Then
strImgPath = strImgPath & ""
End If

Set objMail = _
Application.ActiveInspector.CurrentItem
Set objAttachments = objMail.Attachments

For Each objAttachment In objAttachments
objAttachment.SaveAsFile _
strImgPath & _
objAttachment.FileName
Next

Set objAttachment = Nothing
Set objAttachments = Nothing
Set objMail = Nothing

End Sub

Excel Marko – Serienmails

Dienstag, Dezember 2nd, 2008

Hier ein kleines Excel Marko um aus einer Mail – Adressliste direkt aus Excel über Outlook Serienmails zu verschicken.

Das Beispiel ist nur für 5 Mailadressen geschrieben. Kann aber beliebig erweitert werden.

Sub Excel_Mail_Outlook()
Dim OutApp As Object, Mail As Object
Dim i As Integer
Dim Nachricht

For i = 1 To 5  ‚Anzahl der Mailadressen in Schreife einbauen
‚Variablen neu deklarieren
Set OutApp = CreateObject(„Outlook.Application“)
Set Nachricht = OutApp.CreateItem(0)

With Nachricht
.To = Cells(i, 1)            ‚Mail-Adresse
.Subject = Cells(1, 2)   ‚Betreff
.Body = Cells(1, 3) ‚Sendetext
.Display
SendKeys „%s“, True
End With

‚Variablen zurücksetzen
Set OutApp = Nothing
Set Nachricht = Nothing
Application.Wait (Now + TimeValue(„0:00:05“))
Next i
End Sub