tux-buster.com Makro's Archive

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

Posted in Makro's | No Comments »

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

Posted in Makro's | No Comments »