schau doch mal in der Recherche unter "Outlook".
Dort findest du Beispiele, wie du E-Mails mit variabler Adresse versendest.
Gruß
Mike
Beispiel:
Dim usermail As String
[...]
usermail = Range("A1").Value
[...]
Set nachricht = OutApp.CreateItem(0)
With nachricht
.To = usermail
.cc = "user@host.de"
.Subject = betreff
.Body = mailbody
.Send
End With
Set OutApp = Nothing
Set nachricht = Nothing
[...]
Ingo
Sub Reservierung_Speichern()
Sheets("Reservierung").Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sbPath As String
sbPath = Worksheets(5).Range("D11")
sbPath = "F:\Bootshaus\Rechnungen\Reservierungen\Reservierung Nr_" & sbPath
ActiveSheet.Copy
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
ActiveWindow.DisplayHeadings = False
ActiveSheet.DisplayPageBreaks = False
ActiveWorkbook.SaveAs FileName:=sbPath, FileFormat:=xlNormal
Range("A1").Select
ActiveWorkbook.Close
Sheets("Reservierung").Select
With Worksheets(5).Range("D11")
.Value = .Value + 1
End With
Range("F11,H11,D15,D17,D19,D21,D23,C35:D35,C37:D37,C39:D39,H39").Select
Selection.ClearContents
Range("F11").Select
End Sub
Ingo
in Deinen Code Reservierung_Speichern vor End Sub nachstehenden Code aufrufen:
Sub SendMail()
Dim oOL As Object
Dim oOLMsg As Object
Dim oOLRecip As Object
Dim sAddress As String
sAddress = Range("F37").Value
Set oOL = CreateObject("Outlook.Application")
Set oOLMsg = oOL.CreateItem(0)
With oOLMsg
Set oOLRecip = .Recipients.Add(sAddress)
.Subject = "Dies ist ein Outlook-Test"
.Body = ActiveSheet
.Importance = 1
.Send
End With
oOLRecip.Resolve
Set oOLRecip = Nothing
Set oOLMsg = Nothing
Set oOL = Nothing
End Sub
Gruß
Lutz
Sub Reservierung_Speichern()
Sheets("Reservierung").Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sbPath As String
sbPath = Worksheets(5).Range("D11")
sbPath = "F:\Bootshaus\Rechnungen\Reservierungen\Reservierung Nr_" & sbPath
ActiveSheet.Copy
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
ActiveWindow.DisplayHeadings = False
ActiveSheet.DisplayPageBreaks = False
ActiveWorkbook.SaveAs FileName:=sbPath, FileFormat:=xlNormal
ActiveWorkbook.SendMail "star.biker@asamnet.de"
Range("A1").Select
ActiveWorkbook.Close
Sheets("Reservierung").Select
With Worksheets(5).Range("D11")
.Value = .Value + 1
End With
Range("F11,H11,D15,D17,D19,D21,D23,C35:D35,C37:D37,C39:D39,H39").Select
Selection.ClearContents
Range("F11").Select
End Sub
usermail = Range("A1").Value
[...]
ActiveWorkbook.SendMail Recipients:=usermail
[...]
...probierst??
http://xlfaq.herber.de/texte/076099h.htm