Mail-Anhang abspeichern und Body-Text als txt abspeichern

Home-›Foren-›Outlook-›Outlook VBA-›Mail-Anhang abspeichern und Body-Text als txt abspeichern

  • Dieses Thema hat 4 Antworten sowie 1 Stimme und wurde zuletzt vor 19:25 um 6. Juli 2010 von Unbekannt aktualisiert.
5 Antworten anzeigen - 1 bis 5 (von insgesamt 5)
  • Autor
    Beitrag
  • #51694
    Unbekannt
    Teilnehmer

      Hallo!

      Ich möchte ein Makro bauen, welches per Regel-Assistent ausgeführt wird. Dieses soll Attachments in einem Pfad abspeichern und den Mitteilungstext (Body-Text der Mail) als txt-Datei abspeichern. Dazu habe ich schon zwei Beispiele gefunden, die ich jedoch nicht zusammenfügen kann. Könntet ihr mir helfen?

      Mail-Inhalt speichern (sollte aber nur den Body speichern):
      Code:

      Public Enum olSaveAsTypeEnum
      olSaveAstxt = 0
      End Enum

      Private WithEvents Items As Outlook.Items

      Private Const MAIL_PATH As String = \”c:\\\”

      Private Sub TextSpeichern(Ns As Outlook.NameSpace)

      Set Ns = Application.GetNamespace(\”MAPI\”)
      Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
      End Sub

      Private Sub Items_ItemAdd(ByVal Item As Object)
      If TypeOf Item Is Outlook.MailItem Then
      SaveMailAsFile Item, olSaveAstxt, MAIL_PATH
      End If
      End Sub

      Public Sub SaveMailAsFile(oMail As Outlook.MailItem, _
      eType As olSaveAsTypeEnum, _
      sPath As String _
      )
      Dim sName As String
      Dim sExt As String

      oMail.To = \”\”
      oMail.Subject = \”\”

      eType = olSaveAstxt: sExt = \”.txt\”

      sName = \”versuch\” & sExt

      oMail.SaveAs sPath & sName, eType
      End Sub

      Private Sub ReplaceCharsForFileName(sName As String, _
      sChr As String _
      )
      sName = Replace(sName, \”/\”, sChr)
      sName = Replace(sName, \”\\\”, sChr)
      sName = Replace(sName, \”:\”, sChr)
      sName = Replace(sName, \”?\”, sChr)
      sName = Replace(sName, Chr(34), sChr)
      sName = Replace(sName, \”<\", sChr) sName = Replace(sName, \">\”, sChr)
      sName = Replace(sName, \”|\”, sChr)
      End Sub

      Attachment abspeichern:
      Code:

      Public Sub AufnahmeMailVerschicken(objNewMail As MailItem)
      Dim Ordnername As String
      Dim objPosteingang As MAPIFolder
      Dim anzahl
      Dim i

      On Error Resume Next
      Set objPosteingang = Application.GetNamespace(\”MAPI\”).GetDefaultFolder(olFolderInbox)
      For Each objNewMail In objPosteingang.Items
      With objNewMail
      If .UnRead = True Then
      anzahl = .Attachments.Count
      If anzahl > 0 Then
      Ordnername = \”C:\\\” & objNewMail.SenderName
      MkDir Ordnername
      For i = 1 To anzahl
      .Attachments.Item(i).SaveAsFile Ordnername & \”\\\” & .Attachments.Item(i).FileName
      Next i
      End If
      End If
      End With
      Next objNewMail
      End Sub

      Danke schon im Voraus für eure Hilfe!

      cyber.space

      #181082
      Unbekannt
      Teilnehmer

        Moin

        Versuch`s mal so:
        Sub test(Item As Outlook.MailItem)
        Dim F As Integer
        anzahl = Item.Attachments.Count
        If anzahl > 0 Then Else Exit Sub \’ nur wenn Anhang dran
        Ordnername = \”C:\\test\”
        \’ nimmt ersten Anhang, sonst müsste mann eine Schleife einbauen
        Item.Attachments.Item(1).SaveAsFile Ordnername & \”\\\” & Item.Attachments.Item(1).FileName
        Text = Item.Body
        sFilename = \”C:\\test.txt\”

        \’ Datei zum Schreiben öffnen
        \’ Achtung: bisheriger Inhalt wird gelöscht!
        F = FreeFile
        Open sFilename For Output As #F
        Print #F, Text
        Close #F
        End Sub

        Diese sub in ThisOutlookSession rein
        Regel : bei Ankunft Skript ausführen

        Habs nicht getestet

        mfg
        Thomas

        #181213
        Unbekannt
        Teilnehmer

          Hallo!

          Danke Thomas! Das Skript funktioniert schon sehr gut! Nur habe ich in dieser Mail 3 Bilder und 1 Mp3-file drinnen. Effektiv wird aber nur ein Bild und kein mp3-file abgespeichert. Habt ihr dafür eine Erklärung?

          Es wär echt super, wenn ich das Problem noch lösen könnte!

          mfg

          cyber.space

          #181219
          Unbekannt
          Teilnehmer

            Hallo!

            Mein Problem hat sich erledigt. Ich habe eine Schleife hineingebaut.

            Danke für die Hilfe!!!

            mfg

            cyber.space

            #181259
            Unbekannt
            Teilnehmer

              http://www.mailonizer.de

              … wenn Du genug hast vom Programmieren.

            5 Antworten anzeigen - 1 bis 5 (von insgesamt 5)

            Hat Ihnen der Beitrag gefallen?

            1 Stern2 Sterne3 Sterne4 Sterne5 Sterne (Keine Bewertung vorhanden)
            Loading...