18.07.2019, 10:31
ja danke dir
ich habe jetzt ein neueres Problem, und ich finde nicht wo der button für ein neues Thema ist :22:
im folgenden habe ich eine riesen liste einige werte der jeweoils ausgewählten zeile sollen durch Platzhalter in die Nachricht eingefügt werden.
so wie ich es jetzt habe funktioniert es zumindest für den namen, jeder weitere wert wird dabei leider nicht berücksichtigt, da Excel sich immer auf den jeweils letzten weert bezieht.
wie bekomme ich es also hin, dass Excel alle Platzhalter ersätzt?
(sm br´sten ohne allzuviel am Code zu ändern)
Also das ist der gesammte Code
funktioniert auch, bis auf, dass ich in dem falle nur die Teilenummer in meiner mail habe, nicht den rast
ich möchte aber alle Werte ersetzt bekommen
ich habe jetzt ein neueres Problem, und ich finde nicht wo der button für ein neues Thema ist :22:
im folgenden habe ich eine riesen liste einige werte der jeweoils ausgewählten zeile sollen durch Platzhalter in die Nachricht eingefügt werden.
so wie ich es jetzt habe funktioniert es zumindest für den namen, jeder weitere wert wird dabei leider nicht berücksichtigt, da Excel sich immer auf den jeweils letzten weert bezieht.
wie bekomme ich es also hin, dass Excel alle Platzhalter ersätzt?
(sm br´sten ohne allzuviel am Code zu ändern)
Code:
Option Explicit
Sub BtnEmail_Senden()
Send_Email
End Sub
Private Sub Send_Email()
'-------------< Send_Email() >-------------
Dim sTitle As String
sTitle = "Test-HTML Email from Excel"
'< HMTL holen >
Dim sTemplate As String
sTemplate = Sheets("ini_Vorlage").Shapes(1).TextFrame2.TextRange.Text
'</ HMTL holen >
'----< Send with Outlook >----
Dim app_Outlook As Outlook.Application
Set app_Outlook = New Outlook.Application
'--< Email einstellen >--
Dim objEmail As Outlook.MailItem
Dim sEmail_Address As String
Dim iRow As Integer
For iRow = 4 To 100
If Cells(iRow, 3) = "x" Then
'< get Email Address >
'Column 2, B
sEmail_Address = Cells(iRow, 2)
'</ get Email Address >
'< Fill Placeholders >
Dim sHTML As String
sHTML = Replace(sTemplate, "[@Name]", Cells(iRow, 1))
sHTML = Replace(sTemplate, "[@Kundennummer]", Cells(iRow, 8))
sHTML = Replace(sTemplate, "[Auftragsnummer]", Cells(iRow, 9))
sHTML = Replace(sTemplate, "[Teilenummer]", Cells(iRow, 10))
'</ Fill Placeholders >
'--< Send Email >--
Set objEmail = app_Outlook.CreateItem(olMailItem)
objEmail.To = sEmail_Address
objEmail.Subject = sTitle
'objEmail.HTMLBody = sHTML '*use .HTMLBody for HTML
objEmail.Body = sHTML '*and .body for pure Text
objEmail.Display
'--</ Send Email >--
End If
Next
'< Abschluss >
Set objEmail = Nothing
Set app_Outlook = Nothing
'</ Abschluss >
MsgBox "Emails erstellt", vbInformation, "Fertig"
'----</ Send with Outlook >----
'-------------</ Send_Email() >-------------
End Sub
'---get Text--
'sTemplate = Sheets("ini_Vorlage").Shapes(1).DrawingObject.Text
'sTemplate = Sheets("ini_Vorlage").Shapes(1).TextFrame.Characters.Text
'or sHTML=Sheets("ini_Vorlage").Shapes(1).Textframe.Characters.Text
'.TextRange.Characters.Text
Also das ist der gesammte Code
funktioniert auch, bis auf, dass ich in dem falle nur die Teilenummer in meiner mail habe, nicht den rast
Code:
'--< Email einstellen >--
Dim objEmail As Outlook.MailItem
Dim sEmail_Address As String
Dim iRow As Integer
For iRow = 4 To 100
If Cells(iRow, 3) = "x" Then
'< get Email Address >
'Column 2, B
sEmail_Address = Cells(iRow, 2)
'</ get Email Address >
'< Fill Placeholders >
Dim sHTML As String
sHTML = Replace(sTemplate, "[@Name]", Cells(iRow, 1))
sHTML = Replace(sTemplate, "[@Kundennummer]", Cells(iRow, 8))
sHTML = Replace(sTemplate, "[Auftragsnummer]", Cells(iRow, 9))
sHTML = Replace(sTemplate, "[Teilenummer]", Cells(iRow, 10))
'</ Fill Placeholders >ich möchte aber alle Werte ersetzt bekommen
