Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Makro um Attachments abzuspeichern

Frage Microsoft Outlook & Mail

Mitglied: nube-li

nube-li (Level 1) - Jetzt verbinden

10.12.2009 um 15:36 Uhr, 4775 Aufrufe, 5 Kommentare

Hallo Zusammen

Ich habe folgendes Makro:

01.
Sub Anhänge_Abspeichern() 
02.
Dim Ordnername As String 
03.
    Dim objPosteingang As MAPIFolder 
04.
    Dim objNewMail As MailItem 
05.
    On Error Resume Next 
06.
    Set objPosteingang = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) 
07.
    For Each objNewMail In objPosteingang.Items 
08.
        With objNewMail 
09.
            If .UnRead = True Then 
10.
                Anzahl = .Attachments.Count 
11.
                If Anzahl > 0 Then 
12.
                    Ordnername = "C:\temp\" & objNewMail.SenderName 
13.
                    MkDir Ordnername 
14.
                    For i = 1 To Anzahl 
15.
                        .Attachments.Item(i).SaveAsFile Ordnername & "\" & .Attachments.Item(i).FileName 
16.
                    Next i 
17.
                End If 
18.
            End If 
19.
        End With 
20.
    Next objNewMail 
21.
End Sub
Ziel dieses Macros ist es, neu ankommende E-Mails auf Attachments (Anhänge) zu prüfen. Falls vorhanden sind, diese in den Ordner C:\Temp\Absendername\ abzuspeichern, nur leider funktioniert es so nicht. Wieso, weiss ich leider nicht. Kann hier einer helfen?

P.s: Ich wäre auch froh über ein Macro das bestehende E-Mails (Gelesen und ungelesen) "durchscannt" und ggf. Attachments so abspeichert..

Liebe Grüsse
Mitglied: Tommy70
10.12.2009 um 15:43 Uhr
Hallo,

was genau funktioniert nicht? Gibts eine Fehlermeldung?
Du kannst auch mal das On Error Resume Next rausnehmen. Dann solltest du eine Fehlermeldung erhalten.
Bitte warten ..
Mitglied: nube-li
10.12.2009 um 15:52 Uhr
Hallo

Sorry habe mich falsch ausgedrückt: Es funktioniert soweit, dass wenn man es laufen lässt alle Anhänge gespeichert werden.

Wie krieg ich das jetzt so hin, dass dieses Mackro eigentlich immer "Aktiv" ist?

denn sobald es durchgelaufen ist und keine neuen Mails reinkommen sind, bekomme ich die Fehlermeldung:


Laufzeitfehler '75':
Fehler beim Zugriff auf Pfad/Datei


Wenn ich dann auf Debuggen klicke, ist folgende stelle gelb markiert:

01.
MkDir Ordnername
Gruss
Bitte warten ..
Mitglied: Tommy70
10.12.2009 um 16:04 Uhr
Zitat von nube-li:
Laufzeitfehler '75':
Fehler beim Zugriff auf Pfad/Datei


Wenn ich dann auf Debuggen klicke, ist folgende stelle gelb markiert:

01.
> MkDir Ordnername 
02.
> 

Das kommt daher weil es den Ordner schon gibt. Du musst vor dem Erstellen des Ordners prüfen ob es schon einen mit diesem Namen gibt.
Kannst du z.Bsp. so machen:
01.
Function DirExists(ByVal sDirName As String) As Boolean  
02.
    'liefert True zurück, wenn der Ordner existiert  
03.
    If (Dir(sDirName , vbDirectory) <> "") Then  
04.
        DirExists= True  
05.
    Else  
06.
        DirExists= False  
07.
    End If  
08.
End Function
Allerdings wirst du dann auch das Problem haben dass wenn eine Mail zweimal abgearbeitet wird er die Anhänge nochmal abspeichern will und auch da mit einem Fehler beendet da es die Datei schon gibt.

Das geht so.
01.
Function FileExists(sFilePath As String) As Boolean 
02.
    On Error Resume Next 
03.
    FileExists = Dir(sFilePath) <> "" 
04.
    FileExists = FileExists And Err.Number = 0 
05.
    On Error GoTo 0 
06.
 End Function
Bitte warten ..
Mitglied: nube-li
14.12.2009 um 14:27 Uhr
Hallo Tommy

Ok, danke für deine Hilfe. Aber ich weiss ehrlich gesagt nicht wie und wo ich das einbauen sollte/kann?!

Kannst du mir weiterhelfen? Schlussendlich sollte das Macro so aussehen, dass sobald ein Mail mit Attachment ankommt, dieses Attachment gespeichert wird und der E-Mail- Betreff mit dem Pfad des gespeicherten Attachments erweitert wird.

Sprich das Macro muss immer "aktiv" sein.

Liebe Grüsse
Bitte warten ..
Mitglied: Tommy70
15.12.2009 um 16:14 Uhr
Dann versuchen wir mal das zusammen zu bauen.

UNGETESTET
01.
Sub Anhänge_Abspeichern() 
02.
Dim Ordnername As String 
03.
    Dim objPosteingang As MAPIFolder 
04.
    Dim objNewMail As MailItem 
05.
    On Error Resume Next 
06.
    Set objPosteingang = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) 
07.
    For Each objNewMail In objPosteingang.Items 
08.
        With objNewMail 
09.
            If .UnRead = True Then 
10.
                Anzahl = .Attachments.Count 
11.
                If Anzahl > 0 Then 
12.
                    Ordnername = "C:\temp\" & objNewMail.SenderName 
13.
                    If (Dir(sDirName , vbDirectory) = "") Then 
14.
                        MkDir Ordnername 
15.
                    end if 
16.
                    For i = 1 To Anzahl 
17.
                         if Dir(Ordnername & "\" & .Attachments.Item(i).FileName) = "" then 
18.
                            .Attachments.Item(i).SaveAsFile Ordnername & "\" & .Attachments.Item(i).FileName 
19.
                         else 
20.
                             msgbox "Datei " & Ordnername & "\" & .Attachments.Item(i).FileName & " bereits vorhanden!" 
21.
                         end if 
22.
                    Next i 
23.
                End If 
24.
            End If 
25.
        End With 
26.
    Next objNewMail 
27.
End Sub
So in etwa sollte es schon besser funktionieren. Allerdings hast du das Problem, dass das Mail ja ungelesen bleibt und daher immer wieder gelesen wird.
Allerdings finde ich, macht es auch keinen Sinn das Mail automatisch auf gelesen zu setzen. Denn das erschwert dem User das Erkennen neuer Nachrichten.

Edit: Und hier ist ein Tipp wie du das Makro automatisch ausführen lassen kannst wenn ein neues Mail reinkommt. Und ganz unten ist sogar ein Beispiel um die Anhänge zu speichern
Bitte warten ..
Ähnliche Inhalte
Exchange Server
Attachments aller eingehenden Mails in Logfile speichern (Exchange 2010) (3)

Frage von joni2000de zum Thema Exchange Server ...

VB for Applications
gelöst VBA-Makro verschwindet nach Speichern (5)

Frage von lupi1989 zum Thema VB for Applications ...

Microsoft Office
gelöst Makro wird beim öffnen Vorlage nicht ausgeführt (8)

Frage von Sunny89 zum Thema Microsoft Office ...

Neue Wissensbeiträge
Windows Update

Microsoft Update KB4034664 verursacht Probleme mit Multimonitor-Systemen

Tipp von beidermachtvongreyscull zum Thema Windows Update ...

Viren und Trojaner

CNC-Fräsen von MECANUMERIC werden (ggf.) mit Viren, Trojanern, Würmern ausgeliefert

(4)

Erfahrungsbericht von anteNope zum Thema Viren und Trojaner ...

Windows 10

Windows 10: Erste Anmeldung Animation deaktivieren

(3)

Anleitung von alemanne21 zum Thema Windows 10 ...

Heiß diskutierte Inhalte
Verschlüsselung & Zertifikate
SSL Zertifikat für HTTPS (33)

Frage von Hendrik2586 zum Thema Verschlüsselung & Zertifikate ...

Grafikkarten & Monitore
24" oder 27" mit Full HD oder doch mehr Auflösung? (21)

Frage von brutzler zum Thema Grafikkarten & Monitore ...

Router & Routing
gelöst Linksys wrt1200ac v2 mit dd-wrt: keine vlan-einstellungen im GUI (15)

Frage von Pixi123 zum Thema Router & Routing ...