Clever-Excel-Forum

Hallo liebe Excel-Gemeinde,

ich habe ein kleines Problem,

ich möchte per VBA alle Excel-Dateien aus einem Ordner als E-Mail Anhäge verschicken.

Bis jetzt habe ich folgenden Code:

Sub Datenübermittlung()

Dim Outlook As Object
Dim Mail As Object
Dim Att As Object
Dim strDateiname As String
Dim Pfad As String

Dim Laufwerk As String

Laufwerk = (Tabelle1.Range("A2").Value)

Pfad = (Laufwerk) & "" & "\DE\Bremen\Garden\Front Office\Module\Personal\*.xlsx"

Set Outlook = GetObject(, "outlook.application")
Set Mail = Outlook.CreateItem(0)

Mail.To = "tom@mustermann.de"
Mail.Subject = "Datenübermittlung vom " & " " & Format(Now, "DD.MM.YYYY")

Mail.Attachments.Add (Pfad)

Mail.Body = ("Sehr geehrte Damen und Herren,")

Mail.Display ' Mail wird angezeigt, nicht direkt versandt.

End Sub

Das ganze klappt, wenn ich eine konkrete Datei auswähle, aber wenn ich mit * auswähle kommt die Meldung Datei nicht gefunden.

Wie kann ich das Problem lösen?

Lieben Gruß Frank

Hallo,

z. B. so:

Code:
Option Explicit

Public Sub Main()

    Dim objOutApp As Object

    Dim strOrdner As String

    Dim strDatei As String

    Set objOutApp = CreateObject("Outlook.Application").CreateItem(0)

    strOrdner = "C:\Temp\Closed\"

    If Right$(strOrdner, 1) <> "\" Then strOrdner = strOrdner & "\"

    With objOutApp

        .To = "max@mustermann.de"

        .Subject = "Datenübermittlung vom " & " " & Format(Now, "DD.MM.YYYY")

        .Body = "Sehr geehrte Damen und Herren," & vbCr & vbCr & _

            "Sehr wichtiger Text." & vbCr & _

            "Der ist NOCH wichtiger!" & vbCr & _

            "Jetzt wird es peinlich." & vbCr & _

            "DAS GLAUBT KEINER!!!" & vbCr

        strDatei = Dir$(strOrdner & "*.xls*")

        Do Until strDatei = vbNullString

            .Attachments.Add strOrdner & strDatei

            strDatei = Dir$

        Loop

        .Display

    End With

    Set objOutApp = Nothing

End Sub

Vielen Dank,

ich habe das ganze jetzt wie folgt gelöst:

Sub Datenübermittlung()

Dim Outlook As Object
Dim Mail As Object
Dim Att As Object
Dim strDateiname As String
Dim strPath As String
Dim strPDF As String
Dim strFile As String

Dim Laufwerk As String

On Error GoTo FehlerVerarbeitung

Laufwerk = (Tabelle1.Range("A2").Value)

strPath = (Laufwerk) & "" & "\DE\Bremen\Garden\Front Office\Module\Personal\"
strFile = Dir(strPath & "Stundenzettel*.xlsx")

Set Outlook = GetObject(, "outlook.application")
Set Mail = Outlook.CreateItem(0)

Mail.To = "max@mustermann.de"
Mail.Subject = "Datenübermittlung vom " & " " & Format(Now, "DD.MM.YYYY")

Do While Len(strFile) > 0
Mail.Attachments.Add strPath & strFile
strFile = Dir
Loop

Mail.Body = ("Hallo Max,") & Chr(10) & "" & Chr(10) & ("anbei die Backup-Sicherungen vom") & " " & Format(Now, "DD.MM.YYYY.") _

& Chr(10) & "" & Chr(10) & (Tabelle1.Range("F19").Value) & Chr(10) & "" & Chr(10) & (Tabelle1.Range("F4").Value)

Mail.Display ' Mail wird angezeigt, nicht direkt versandt.

End Sub

FrankyHB

Case

FrankyHB