Dateien aus einem Ordner als EMail Anhang

[FrankyHB]

Hallo, ich brauche Hilfe.

ich möchte alle Dateien aus dem Ordner "Ausgewählt" per VBA als Anhang an eine EMail einfügen.

Folgenden Code habe ich bisher - leider klappt es nicht:

Code:

Sub EMail_als_PDF_1()

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

'On Error GoTo FehlerVerarbeitung

If Tabelle1.Range("B14").Value = 0 Then
MsgBox "Du musst zuerst eine Rechnung auswählen !", , "Fehlermeldung"
End If

If Not Tabelle1.Range("B14").Value = 0 Then

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

Mail.To = (Tabelle1.Range("C13").Value)
Mail.Subject = (Tabelle1.Range("B22").Value) & " " & (Tabelle1.Range("B14").Value)
[color=#0074D9]Mail.Attachments.Add ("C:\DE\Bremen\Garden\Front Office\Rechnungen\Ausgewählt\*.pdf")[/color]
Mail.Body = (Tabelle1.Range("B25").Value) & Chr(10) & "" & Chr(10) & (Tabelle1.Range("B27").Value) & Chr(10) & "" & Chr(10) & (Tabelle1.Range("B28").Value) _
& Chr(10) & "" & Chr(10) & (Tabelle1.Range("B30").Value) & Chr(10) & "" & Chr(10) & (Tabelle1.Range("B32").Value)

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

Dim Quelle$, Ziel$, FSO As Object
    Quelle = ("C:\DE\Bremen\Garden\Front Office\Rechnungen\Ausgewählt\") & "" & (Tabelle1.Range("B14").Value)
    If Dir(Quelle) = "" Then
        MsgBox "Keine Dateien vorhanden!"
    Else
        Ziel = "C:\DE\Bremen\Garden\Front Office\Rechnungen\versendet\"
        Set FSO = CreateObject("Scripting.FileSystemObject")
        FSO.MoveFile Quelle, Ziel
        Set FSO = Nothing
    End If
   
Call EMailVersand_speichern_Klicken
Call Dateien_auslesen_Klicken
Call Dateien_ausgewählt_Klicken

Tabelle1.Range("B14").Value = 0

End If


End Sub

An der blauen Zeile tritt ein Fehler auf - "Datei oder Ordnername ist ungültig"

Kann mir jemand wieterhelfen?


Gruß Frank

[volti]

Hallo Frank,

ich sehe keine blaue Zeile....

Aber versuch es mal so.....

Code:

'Anlagen anfügen
 sPfad = "C:\DE\Bremen\Garden\Front Office\Rechnungen\Ausgewählt\"
 sDatei = Dir$(sPfad & "*.*")
 Do While sDatei <> ""
    Mail.Attachments.Add sPfad & sDatei
    sDatei = Dir$
 Loop

_________
viele Grüße
Karl-Heinz

[FrankyHB]

Danke,

klappt perfekt.

Gruß Frank

---

Hallo Karl-Heinz,

vielleicht kannst du mir bei noch einem Problem helfen.

Ich habe mit Excel ein EMail Programm erstellt mit dem ich auch mehrere Anhänge in einer EMail verschicken kann.
(Das war das Problem bei dem du mir gerade geholfen hast.)

Die Anhänge sind in Tabelle7 ist Spalte A ab Zeile 2 gespeichert.

Jetzt möchte ich jeden Anhang plus Infos über EMail Adresse, Sendungsdatum etc. im Arbeitsblatt ""versendete Mails"" speichern


Sub EMailVersand_speichern_Klicken()
 
Worksheets("versendete Mails").Activate
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 'erste freie Zeile aktivieren
ActiveSheet.Cells(last, 1).Value = (Tabelle1.Range("B10").Value)
ActiveSheet.Cells(last, 2).Value = (Tabelle1.Range("C13").Value)
ActiveSheet.Cells(last, 3).Value = (Tabelle7.Range("A2").Value)               'EMail-Anhang
ActiveSheet.Cells(last, 4).Value = (Tabelle1.Range("B25").Value)
ActiveSheet.Cells(last, 5).Value = (Tabelle1.Range("B13").Value)
ActiveSheet.Cells(last, 6).Value = Now
ActiveSheet.Cells(last, 7).Value = (Tabelle1.Range("B32").Value)
 
End Sub



Ich brauche jetzt eine Schleife, die solange läuft wie Einträge in Tabelle7 Spalte A sind und den jeweiligen Wert in Tabelle 1 übernehmen.

Wäre toll wenn du eine Idee hättest.

Gruß Frank

[volti]

Hallo Frank,

teste mal, ob dieser Code das macht was Du möchtest...

Code:

Sub EMailVersand_speichern_Klicken()
'eMail-Daten speichern
 Dim iZeile As Long, iLast As Long, sAnhang As String
 
  With Application
   .ScreenUpdating = False
   .EnableEvents = False
   .Calculation = xlCalculationManual
 End With
 
 With Worksheets("versendete Mails")
    iLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1         'erste freie Zeile aktivieren
  
    For iZeile = 2 To Tabelle7.Cells(Rows.Count, 1).End(xlUp).Row
        sAnhang = Tabelle7.Cells(iZeile, "A").Value
        
        If sAnhang <> "" Then
            .Cells(iLast, 1).Value = Tabelle1.Range("B10").Value
            .Cells(iLast, 2).Value = Tabelle1.Range("C13").Value
            .Cells(iLast, 3).Value = sAnhang                    'EMail-Anhang
            .Cells(iLast, 4).Value = Tabelle1.Range("B25").Value
            .Cells(iLast, 5).Value = Tabelle1.Range("B13").Value
            .Cells(iLast, 6).Value = Now
            .Cells(iLast, 7).Value = Tabelle1.Range("B32").Value
            iLast = iLast + 1
        End If
    
    Next iZeile
 End With
 
 With Application
   .ScreenUpdating = True
   .EnableEvents = True
   .Calculation = xlCalculationAutomatic
 End With
 
End Sub

_________
viele Grüße
Karl-Heinz

[FrankyHB]

Vielen Dank für deine Hilfe - klappt super.

Gruß Frank

[FrankyHB]

Hallo Karl-Heinz,

ich muß nur noch ein Problem lösen:


Dim i As Long
  For i = 2 To Tabelle8.Cells(Rows.Count, 1).End(xlUp).Row
    With Worksheets("versendete Mails").Cells(Rows.Count, 1).End(xlUp)
   
    Tabelle1.Range("B10").Value = Format(Now, "DDMMYYHHmmss")

      .Offset(1, 0).Value = Tabelle1.Range("B10").Value + 1
      .Offset(1, 1).Value = Tabelle1.Range("C13").Value
      .Offset(1, 2).Value = Tabelle1.Range("C14").Value              'EMail-Anhang
      .Offset(1, 3).Value = Tabelle1.Range("B25").Value
      .Offset(1, 4).Value = Tabelle8.Cells(i, 1).Value
      .Offset(1, 5).Value = Now
      .Offset(1, 6).Value = Tabelle1.Range("B32").Value
    End With
  Next i


Ich möchte, dass sich bei jedem Durchlauf der Schleife der Wert in Spalte A um 1 erhöht.

Ziel ist, in Spalte A eine eingeutige Sendungsnummer zu generieren - aus dem Format des Datums
Tabelle1.Range("B10").Value = Format(Now, "DDMMYYHHmmss")+1

Leider sind die Einträge durch die Schleife immer identisch.

Wie kann man das machen?

Gruß Frank

[volti]

Hallo Frank,

nimm doch den Zeilenzähler für diese Aufgabe heran:

Code:

.Offset(1, 0).Value = Tabelle1.Range("B10").Value + i -2

_________
viele Grüße
Karl-Heinz