Top-Themen

Aktuelle Themen (A bis Z)

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

Mitglied: nube-li

nube-li (Level 1) - Jetzt verbinden

10.12.2009 um 15:36 Uhr, 4796 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
Batch & Shell

Outlook Attachments....nicht alle werden gespeichert

Frage von Dpole86Batch & Shell5 Kommentare

Hallo zusammen ich versuche mich gerade in VBA. Allerdings habe ich das Problem das nicht alle Attachments gespeichert werden. ...

Microsoft Office

Terminalserver Outlook Installation: öffnet keine attachments

Frage von seventowerMicrosoft Office7 Kommentare

Moin, ein HYPER-V Host Windows 2012 Datacenter drei VM : DC, ES, Terminalserver(RDS) auf dem RDS Office 2013 Professional ...

Microsoft Office

Excel Makro

Frage von maloh1984Microsoft Office4 Kommentare

Hallo Habe ein Problem, ein Kunde der hat Excellisten mit Makro die lassen sich öffnen aber die Buttons reagieren ...

Microsoft Office

Excel-Makro

gelöst Frage von yuki13Microsoft Office7 Kommentare

Hallo Zusammen!! :-) Ich bin nicht so fit in Excel Makros und wollte mich hier erkundigen, ob mir jemand ...

Neue Wissensbeiträge
Windows 10

USB Maus und Tastatur versagen Dienst unter Windows 10

Erfahrungsbericht von hardykopff vor 7 StundenWindows 103 Kommentare

Da steht man ziemlich dumm da, wenn der PC sich wegen fehlender USB Tastatur und Maus nicht bedienen lässt. ...

Administrator.de Feedback
Update der Seite: Alles zentriert
Information von Frank vor 10 StundenAdministrator.de Feedback10 Kommentare

Hallo User, die größte Änderung von Release 5.8 ist das Zentrieren der Webseite (auf großen Bildschirmen) und ein "Welcome"-Teaser ...

Humor (lol)

WhatsApp-Nachrichten endlich auch per Bluetooth versendbar

Information von BassFishFox vor 1 TagHumor (lol)4 Kommentare

Genau darauf habe ich gewartet! ;-) Der beliebte Messaging-Dienst WhatsApp erhält eine praktische neue Funktion: Ab dem nächsten Update ...

Google Android

Googles "Android Enterprise Recommended" für Unternehmen

Information von kgborn vor 1 TagGoogle Android3 Kommentare

Hier eine Information, die für Administratoren und Verantwortliche in Unternehmen, die für die Beschaffung und das Rollout von Android-Geräten ...

Heiß diskutierte Inhalte
Server-Hardware
Welche Rolle spielt Design bei Enterprise IT Hardware?
Frage von ApolloXServer-Hardware17 Kommentare

Ich arbeite für einen internationalen Elektronikhersteller in der Forschung und meine Aufgabe ist es, Feedback von Nutzern in Hinsicht ...

Windows Netzwerk
WSUS4 und Windows 10 Updates automatisch installieren
Frage von sammy65Windows Netzwerk15 Kommentare

Hallo miteinander, ich habe mit einen neuen WSUS Server aufgesetzt Server 2016 darauf einen aktuellen WSUS. Grund, wir stellen ...

Speicherkarten
Vergessliche USB-Sticks?
Frage von hanheikSpeicherkarten14 Kommentare

Ich habe in den letzten Tagen 500 USB-Sticks mit Bilddateien bespielt. Obwohl ich die Dateien mit größter Sorgfalt kopiert ...

Switche und Hubs
Cisco SG350X-48 AdminIP in anderes VLAN
Frage von lcer00Switche und Hubs14 Kommentare

Hallo zusammen, ich habe ein Problem mir einem Cisco SG350X-48 bei der Erstinstallation wurde eine IP 192.168.0.254 (Default VLAN ...