Bestimmte Datei unter allen angehängten Dateien finden

HomeForenOutlookOutlook VBABestimmte Datei unter allen angehängten Dateien finden

Ansicht von 2 Beiträgen - 1 bis 2 (von insgesamt 2)
  • Autor
    Beitrag
  • #54058

    Unbekannt
    Teilnehmer

    Hallo Experten!

    Ich bekomme im Outlook Mails von Kunden mit immer den gleichen Anhängen. Nun muss ich jeweils einen bestimmten Anhang abspeichern und zwar eine Excel-Datei, die immer gleich heisst. Damit ich sie unterscheiden kann, muss ich ihr die Kundennummer voranstellen, die ich in der Datei auf der Tabelle \“Lieferschein\“ finde. Mit nachfolgendem Makro suche ich in den Anhängen nach der Datei \“Repo\“, öffne sie und speichere sie unter dem neuen Namen ab.

    Soweit funktioniert der Code. Nur wenn die gesuchte Datei nicht dem ersten Anhang entspricht, wird die Datei nicht abgespeichert. Kann mir jemand helfen, wie ich den Code anpassen muss, damit die Datei unter allen Anhängen gefunden wird?

    Ausserdem hänge ich am Ende des neuen Dateinamens noch das entsprechende Quartal an, welches ich ebenfalls auf dem Lieferschein finde (Zelle H11). Dort ist das Quartal im Format \“30.06.2011\“ gespeichert. Ich möchte im Dateinamen aber das Format \“201106\“ verwenden: wie kann ich das erreichen?

    Bin für jede Hilfe dankbar!

    Gruss coko

    PS: Ich muss Outlook aus Excel heraus steuern, weil bei uns in der Firma aus Sicherheitsgründen Makros in Outlook deaktiviert sind.

    Hier mein Code:

    Sub Anhang_Speichern()
    Dim OLApp As Outlook.Application
    Dim OLNS As Outlook.Namespace
    Dim OLOrdner As MAPIFolder
    Dim Nachricht As Outlook.MailItem
    Dim AnhName As String
    Dim TempOrdner As String
    Dim ZielRepo As String
    Dim Quartal As String
    Dim KDNR As String

    Set OLApp = Outlook.Application
    Set OLNS = OLApp.GetNamespace(\“MAPI\“)
    Set OLOrdner = OLNS.PickFolder

    TempOrdner = \“C:\\Testordner1\\\“
    ZielRepo = \“C:\\Testordner2\\\“

    On Error Resume Next

    For Each Nachricht In OLOrdner.Items

    If Nachricht.UnRead = True Then
    If Nachricht.Attachments.Count > 0 Then
    AnhName = Nachricht.Attachments.item(1).DisplayName
    If InStr(AnhName, \“Repo\“) > 0 Then
    Nachricht.Attachments.item(1).SaveAsFile TempOrdner & AnhName

    Workbooks.Open TempOrdner & AnhName
    KDNR = Sheets(\“Lieferschein\“).Range(\“C15\“)
    Quartal = Sheets(\“Lieferschein\“).Range(\“H11\“)
    ActiveWorkbook.SaveAs ZielRepo & KDNR & \“-\“ & \“Repo_\“ & Quartal & \“.xlsx\“
    ActiveWorkbook.Close False
    Kill TempOrdner & AnhName

    End If
    End If
    End If

    Set Nachricht = Outlook.ActiveInspector.CurrentItem
    Nachricht.Subject = KDNR & \“-\“ & Nachricht.Subject
    Nachricht.UnRead = False
    Nachricht.Save
    Set OLOrdnerQuartal = OLNS.PickFolder
    Nachricht.Move (OLOrdnerQuartal)

    Next Nachricht

    MsgBox \“ Alle Mails wurden bearbeitet!\“

    End Sub

    #187114

    Unbekannt
    Teilnehmer

    Ich konnte inzwischen mein Problem – mit Hilfe von Tipps aus einem anderen Forum – lösen. Mein Code sieht nun so aus und funktioniert bei mir einwandfrei:

    Sub Anhang_Speichern()
    Dim OLApp As Outlook.Application
    Dim OLNS As Outlook.Namespace
    Dim OLOrdner As MAPIFolder
    Dim Nachricht As Outlook.MailItem
    Dim AnhName As String
    Dim TempOrdner As String
    Dim ZielRepo As String
    Dim Quartal As String
    Dim KDNR As String

    Set OLApp = Outlook.Application
    Set OLNS = OLApp.GetNamespace(\“MAPI\“)
    Set OLOrdner = OLNS.PickFolder

    TempOrdner = \“C:\\Testordner1\\\“
    ZielRepo = \“C:\\Testordner2\\\“

    On Error Resume Next

    For Each Nachricht In OLOrdner.Items

    If Nachricht.UnRead = True Then
    Anzahl = Nachricht.Attachments.Count
    If Anzahl > 0 Then
    For i = 1 To Anzahl
    AnhName = Nachricht.Attachments.item(i).Filename
    If InStr(AnhName, \“Repo\“) > 0 Then
    Nachricht.Attachments.item(i).SaveAsFile TempOrdner & AnhName

    Workbooks.Open TempOrdner & AnhName
    BCNR = Sheets(\“Lieferschein\“).Range(\“C15\“)
    Quartal = Sheets(\“Lieferschein\“).Range(\“H11\“)
    ActiveWorkbook.SaveAs ZielRepo & KDNR & \“-\“ & \“Repo_\“ & Quartal & \“.xlsx\“
    ActiveWorkbook.Close False
    Kill TempOrdner & AnhName
    End If
    Next i

    End If
    End If

    Set Nachricht = Outlook.ActiveInspector.CurrentItem
    Nachricht.Subject = KDNR & \“-\“ & Nachricht.Subject
    Nachricht.UnRead = False
    Nachricht.Save
    Set OLOrdnerQuartal = OLNS.PickFolder
    Nachricht.Move (OLOrdnerQuartal)

    Next Nachricht

    MsgBox \“ Alle Mails wurden bearbeitet!\“

    End Sub

    Vielleicht hilft der Code ja sonst noch jemandem weiter 😉
    Gruss coko

Ansicht von 2 Beiträgen - 1 bis 2 (von insgesamt 2)

Du musst angemeldet sein, um auf dieses Thema antworten zu können.

-

Hat Ihnen der Beitrag gefallen?

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