mail auf anlagen prüfen - Page 3 - Digital-Inn

bst · 27-01-2009

Hi Nils,

hmm, so meinte ich das nicht. Wann und wie willst Du das denn eingeben?

Das wird ja von Outlook automatisch aufgerufen sobald eine neue Mail ankommt.

Das dort in einer Inputbox zu fragen wäre M.E. ziemlich unpraktisch.

Und, lösche die Zeile mit dem Const mal raus und nimm sowas.

cu, Bernd
--

Code:

Private Sub PrintAttachments(oMail As Outlook.MailItem)
   Dim oAtt As Outlook.Attachment
   Dim sFile As String
   Dim sPath As String
   
   sPath = "P:\Attachments\" & Format(Date, "YYYYMMDD") & "\"
   
   On Error Resume Next
   
   For Each oAtt In oMail.Attachments
      ' Nur ausgewählte Dateitypen speichern
      Select Case LCase$(Right$(oAtt.FileName, 4))
         Case ".pdf"
         ' Hier kommt eine auskommentierte Message-Box, mit Speicherabfrage Ja-Nein
         ' If MsgBox("Datei speichern ?", vbYesNo, "Speichern") = vbYes Then
         
         sFile = sPath & oAtt.FileName
         oAtt.SaveAsFile sFile
         ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
         ' End If
      End Select
   Next
End Sub

nke · 27-01-2009

Hallo Bernd,

ich würde das ganze am liebsten direkt im VBA Code reinbringen da sich an den werten nichts ändert.

Zum Speicherpfad, habe die Änderungen so vorgenommen - funktioniert aber nicht.

Muss das "Tagesverzeichnis" nicht erst erstellt werden damit er rein speichern kann?

Danke + Gruß, Nils

bst · 27-01-2009

Hi Nils,

ja, der Pfad muss (oben) zuvor erstellt werden. Versuche vielleicht mal sowas.

Du musst die 3 Konstanten am Anfang anpassen. Das Verzeichnis csPath muss existieren, die Unterverzeichnisse darin werden - falls nötig - vom VBA erstellt.

HTH, Bernd
--

Code:

Option Explicit

' Makro zum automatischen Drucken von Dokumenten aus Mail-Anlagen

Const csPath As String = "P:\Attachments\"
Const csSubject As String = "*test*"
Const csSenderName As String = "*bernd*"

' Aufruf der Prozedur
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
      ByVal hwnd As Long, _
      ByVal lpOperation As String, _
      ByVal lpFile As String, _
      ByVal lpParameters As String, _
      ByVal lpDirectory As String, _
      ByVal nShowCmd As Long _
   ) As Long _
   
Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
   ' Verweis auf den zu überwachenden Mail-Ordner.
   Set Items = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
   Dim mItem As Outlook.MailItem
   
   If TypeOf Item Is Outlook.MailItem Then
      Set mItem = Item
      If mItem.Attachments.Count > 0 Then
         Debug.Print mItem.Subject, mItem.SenderName
         If LCase(mItem.Subject) Like csSubject And LCase(mItem.SenderName) Like csSenderName Then
            PrintAttachments mItem
         End If
      End If
   End If
End Sub

Private Sub PrintAttachments(oMail As Outlook.MailItem)
   Dim oAtt As Outlook.Attachment
   Dim sPath As String
   Dim sFile As String
   
   On Error Resume Next
   sPath = csPath & Format(Date, "YYYYMMDD") & "\"
   If Dir(sPath & "*.*", vbDirectory) = "" Then MkDir sPath
   
   For Each oAtt In oMail.Attachments
      ' Nur ausgewählte Dateitypen speichern
      Select Case LCase$(Right$(oAtt.FileName, 4))
         Case ".pdf"
            sFile = sPath & oAtt.FileName
            oAtt.SaveAsFile sFile
            ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
      End Select
   Next
End Sub

nke · 29-01-2009

Sooooo, habe das Ablegen nun anders gelöst.
Filtern nach dem Sender und/oder Betreff habe ich nicht hinbekommen - läuft zur Zeit aber so.

PHP Code:


			
Option Explicit



' Makro zum automatischen Drucken von Dokumenten aus Mail-Anlagen





' Aufruf der Prozedur

Private Declare Function ShellExecute Lib "shell32.dll" Alias _

"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _

ByVal lpFile As String, ByVal lpParameters As String, _

ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long _





Private WithEvents Items As Outlook.Items



' Verzeichnis, in dem die Anlagen gespeichert werden sollen



Private Const ATT_PATH As String = "P:\Attachments\"



Private Sub Application_Startup()



    ' Verweis auf den zu überwachenden Mail-Ordner.

    

    Set Items = Application.GetNamespace("MAPI") _

        .GetDefaultFolder(olFolderInbox).Items

End Sub



Private Sub Items_ItemAdd(ByVal Item As Object)

    Dim mItem As Outlook.MailItem

             

        If TypeOf Item Is Outlook.MailItem Then

            Set mItem = Item

        

            If mItem.Attachments.Count > 0 Then PrintAttachments mItem

        End If

    End Sub



Private Sub PrintAttachments(oMail As Outlook.MailItem)

    Dim mItem As Outlook.MailItem

    Dim oAtt As Outlook.Attachment

    Dim sFile As String

    

    On Error Resume Next

    

    For Each oAtt In oMail.Attachments

    

        ' Nur Anhänge vom Dateityp .pdf berücksichtigen

        

        Select Case LCase$(Right$(oAtt.FileName, 4))

            Case ".pdf"

                

                    ' Anhang ablegen (YYYYMMDD_HHMMSS_Filename.pdf) und drucken

                

                    sFile = ATT_PATH & Format(Date, "YYYYMMDD") & "_" & Format(Time, "HHMMSS") & "_" & oAtt.FileName

                    oAtt.SaveAsFile sFile

                    ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0

                                                    

        End Select

    Next

End Sub

Vielen Dank für die schnelle Hilfe hier im Board!

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

27-01-2009	#32
nke Registered User Join Date: Jan 2009 Location: Delmenhorst Posts: 4 Abgegebene Danke: 2 Erhielt 0 Danke für 0 Beiträge	Hallo Bernd, ich würde das ganze am liebsten direkt im VBA Code reinbringen da sich an den werten nichts ändert. Zum Speicherpfad, habe die Änderungen so vorgenommen - funktioniert aber nicht. Muss das "Tagesverzeichnis" nicht erst erstellt werden damit er rein speichern kann? Danke + Gruß, Nils

29-01-2009	#34
nke Registered User Join Date: Jan 2009 Location: Delmenhorst Posts: 4 Abgegebene Danke: 2 Erhielt 0 Danke für 0 Beiträge	Sooooo, habe das Ablegen nun anders gelöst. Filtern nach dem Sender und/oder Betreff habe ich nicht hinbekommen - läuft zur Zeit aber so. PHP Code: Option Explicit ' Makro zum automatischen Drucken von Dokumenten aus Mail-Anlagen ' Aufruf der Prozedur Private Declare Function ShellExecute Lib "shell32.dll" Alias _ "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _ ByVal lpFile As String, ByVal lpParameters As String, _ ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long _ Private WithEvents Items As Outlook.Items ' Verzeichnis, in dem die Anlagen gespeichert werden sollen Private Const ATT_PATH As String = "P:\Attachments\" Private Sub Application_Startup() ' Verweis auf den zu überwachenden Mail-Ordner. Set Items = Application.GetNamespace("MAPI") _ .GetDefaultFolder(olFolderInbox).Items End Sub Private Sub Items_ItemAdd(ByVal Item As Object) Dim mItem As Outlook.MailItem If TypeOf Item Is Outlook.MailItem Then Set mItem = Item If mItem.Attachments.Count > 0 Then PrintAttachments mItem End If End Sub Private Sub PrintAttachments(oMail As Outlook.MailItem) Dim mItem As Outlook.MailItem Dim oAtt As Outlook.Attachment Dim sFile As String On Error Resume Next For Each oAtt In oMail.Attachments ' Nur Anhänge vom Dateityp .pdf berücksichtigen Select Case LCase$(Right$(oAtt.FileName, 4)) Case ".pdf" ' Anhang ablegen (YYYYMMDD_HHMMSS_Filename.pdf) und drucken sFile = ATT_PATH & Format(Date, "YYYYMMDD") & "_" & Format(Time, "HHMMSS") & "_" & oAtt.FileName oAtt.SaveAsFile sFile ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0 End Select Next End Sub Vielen Dank für die schnelle Hilfe hier im Board!

Sponsored Links

Sponsored Links