Versturen meerdere sheets in 1 email.

[HammerJohn]

IK gebruik onderstaande code in VBA om sheets door te sturen alleen stuurt hij maar 1 sheet
nu heb ik op de andere sheet ook in dezelfde cel het emailadres gezet. dit doe ik met range D8

Nu stuurt hij beide sheets alleen afzonderlijk.

Sub Mail_Every_Worksheet()

Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim I As Long

TempFilePath = Environ$("temp") & ""

If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xlsm": FileFormatNum = 52
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

For Each sh In ThisWorkbook.Worksheets
If sh.Range("D8").Value Like "?*@?*.?*" Then

sh.Copy
Set wb = ActiveWorkbook

TempFileName = "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")

With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
For I = 1 To 3
.SendMail sh.Range("d8").Value, _
"Bestellijst NSP dealer"
If Err.Number = 0 Then Exit For
Next I
On Error GoTo 0
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

End If
Next sh

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[gast0660]

Zoiets?

 

[HammerJohn]

Superbedankt

Alleen bleef hij wachten op verzenden maar dat had ik snel gevonden.

Vriendelijk bedankt voor de service

John

 

[gast0660]

Ok:thumb:
Suc6

 

[HammerJohn]

Nog klein vraagje als ik i.p.v D8 D824 stuurt hij hem dan naar alle emailadressen

 

[gast0660]

Naar x aantal email adressen moet je iets anders aanpakken.
Ik post straks wel een uitgewerkt vbtje.

 

[gast0660]

Zoiets?