Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1500to1504
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA-Mail mit Anhang versenden

VBA-Mail mit Anhang versenden
08.07.2016 18:30:29
Hendrik
Schönen guten Tag zusammen,
zuerst einmal vielen Dank euch Allen. Dank eurer Hilfe konnte ich schon einige nervige Excel-Probleme schnell und leicht lösen.
Leider konnte ich heute zu meiner Frage keinen passenden, schon offenen, Post finden.
Würde mich sehr freuen, wenn ihr mir bei meiner Frage helfen könntet...
Ich möchte, wie der Betreff schon erahnen lässt, über VBA aus Excel heraus eine Mail versenden und zwar mit einem Anhang -soweit so gut.
Hierzu habe ich auch einen Code gefunden und soweit wie es meine Möglichkeiten zulassen, auch etwas angepasst. Leider sind meine Möglichkeiten in Sachen VBA doch sehr begrenzt, weshalb es auch beim Abspielen des Codes einen Anwender- bzw. Objektfehler gibt.
Nun zu meiner Frage/Problem.
Ich habe eine Excelmappe mit nur einem Tabellenblatt.
In Spalte C (C2:C"x" - variabel) befinden sich der jeweilige Dateipfad zur jeweiligen Datei, [Pfad wird bereits via VBA ermittelt und in Spalte C ausgegeben] die ich gerne anhängen möchte.
Besonders: Eine Mail sollte immer nur an einen Adressaten (steht in Spalte B2:B"x"-variabel) versendet werden.
Beispiel: Der Adressat in B2 erhält als Anhang Dateipfad C2.
Hier der Code aus dem Editor kopiert:
Sub Outlook1()
Application.DisplayAlerts = False
Dim Anhang As String
Dim olapp As Object
Dim i As Integer
Anhang = Range("C" & i)
For i = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.To = Cells(2, 2)
.Subject = "Liefervorschau vom " & Date
.Body = ""
.Display
.Attachments.Add Anhang
End With
Set olapp = Nothing
Application.DisplayAlerts = True
Next
End Sub
Mein Fehler in diesem Code liegt, gehe ich davon aus, in der Zeile: Anhang = Range("C" & i), da ich das "i" wohl nicht genau definiert habe. Ich hatte versucht mit "For i = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row" einen Loop zu erzeugen - Hier könnt ihr auch meine sehr begrenzten VBA-Skills wiedererkennen.
Frage: Wie muss der Code aussehen, dass der Code für jede Zeile (Adressaten) eine neue Mail öffnet und die dazugehörige Datei angehängt wird für alle Zeilen bis eine Zeile ohne Inhalt erreicht wird.
Vielen Dank vorab und
Viele Grüße
Hendrik

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA-Mail mit Anhang versenden
08.07.2016 18:58:13
ChrisL
Hi Hendrik
Nicht getestet, aber soweit ich sehe bist du nah dran.
Die Zeile...
Anhang = Range("C" & i)
... müsstest du weiter runter verschieben, in die For-Next Schleife rein (ich würde es eine Zeile direkt vor ".Attachments.Add Anhang" platzieren).
Code innerhalb einer For-Next Schleife wird immer wieder ausgeführt und die Variable zählt hoch. z.B.
MsgBox i 'hier ist der Zähler noch auf Null
For i = 1 To 3 'jetzt wird hochgezählt von 1-3
MsgBox i 'Nachricht wird 3x aufgerufen
Next i
cu
Chris

AW: VBA-Mail mit Anhang versenden
09.07.2016 19:13:32
Hendrik
Hey Chris,
vielen Dank für die schnelle Antwort!
Ich werde es nachher gleich mal mit deinem Tipp versuchen. Gebe Dir dann bescheid, ob es funktioniert hat.
lg
Hendrik

Anzeige
AW: VBA-Mail mit Anhang versenden
11.07.2016 17:03:27
Hendrik
Hat super funktioniert! Vielen Dank dafür!
Leider ist mir gerade ein zweites Problem bei meinem Code für die Auflistung des Ordnerinhalts (hier befinden sich die Anhänge für die Mails).
Derzeitig ist das der Code, welcher auch funktioniert... Das Problem liegt aber darin, dass sich der letzte Teile vom Namen des Ordners variiert.
Diese Zeile macht mir Sorgen:
Dateiname = Dir$("S:\SNEID012\Listen\Meine\07_2016_07\*.*")
Was muss ich denn ändern, dass es auch die Dateien ausgibt, wenn sie im Ordner "08_2016_02" liegen. Der Ordnername darf nicht geändert werden und es soll die Dateien aus dem Ordner geben, welchen Monat wir gerade haben. Bsp: Monat_Jahr_Tag [07_2016_01]
Sub DateinamenAuflisten()
'Dateinamen in einem bestimmten Verzeichnis auflisten
Dim Dateiname As String, i As Integer
Range("A2:B500").ClearContents
Dateiname = Dir$("S:\SNEID012\Listen\Meine\07_2016_07\*.*")
Cells(2, 1).Select
Do While Dateiname  ""
ActiveCell.Offset(i, 0) = Dateiname
i = i + 1
Dateiname = Dir$()
Loop
End Sub
Vielen Dank und
Viele Grüße
Hendrik

Anzeige
AW: VBA-Mail mit Anhang versenden
13.07.2016 08:41:54
Hendrik
Vielen Dank Chris für deine Hilfe.
Für diejenigen die mit dem selben Problem auf diesen Beitrag stoßen habe ich von Christian einen Code bekommen.
Hi,
den Code in ein Modul kopieren - hier das ganze mit einem Auswahldialog für den Quellordner.
Du musst den Namen des Zeilblattes noch im Code anpassen: Set ws = ThisWorkbook.Worksheets("Daten")
Gruß,
Christian
Sub DateinamenAuflisten()
'Dateinamen in einem bestimmten Verzeichnis auflisten
Dim Dateiname As String, i As Integer
Dim Pfad As String
Dim ws As Worksheet
' Hier den Namen des Blattes anpassen ("Daten")
Set ws = ThisWorkbook.Worksheets("Daten")
ws.Range("A2:B500").ClearContents
'Funktion GetPath aufrufen um Pfadname zu ermitteln
Pfad = GetPath()
' Wenn kein Ordner ausgewählt wird, hier Ende
If Pfad = "" Then Exit Sub
Dateiname = Dir$(Pfad & "\*.*")
' Wenn kein Ordner keine Dateien enthält, hier Ende
If Dateiname = "" Then Exit Sub
Do While Dateiname ""
ws.Cells(2, 1).Offset(i, 0) = Dateiname
i = i + 1
Dateiname = Dir$()
Loop
MsgBox i & " Dateien im Ordner ''" & Pfad & "'' registriert!"
End Sub
Private Function GetPath() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
' Voreingestellter Pfad, ggf. ändern
.InitialFileName = "S:\SNEID012\Listen\Meine\"
.Title = "Ordnerauswahl"
.InitialView = msoFileDialogViewDetails
.ButtonName = "Ordner wählen"
.Title = "Ordner auswählen"
.Show
If .SelectedItems.Count = 0 Then
GetPath = ""
Else
GetPath = .SelectedItems(1)
End If
End With
End Function

Anzeige

260 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige