Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Makro für E-Mail - Body Problem
#1
Liebes Forum!
Ich sitze schon länger an einem VBA- Projekt und möchte es teilweise verbessern!
Nur leider bin ich auch noch ein bisschen ein Anfänger! Den Code hab ich aus einem Forum bekommen und hab ihn etwas angepasst und verändert. Nur leider funktioniert manches nicht so! z.B dass er mir im E-Mail Text einfach die ersten paar Zeilen nicht schreibt.
Könnt ihr mal kurz darüber schauen, ob ich etwas falsch mache?
Hier der Code:



Option Explicit
Option Compare Text

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" ( _
        ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, _
        ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" ( _
      ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
      ByVal hwnd As LongPtr, ByVal lpString As String, _
      ByVal cch As Long) As Long
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Private Const WM_CLOSE = &H10
Dim hwnd As LongPtr
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2

Sub SendeMail()

'Sendet Monatlich eine E-Mail mit einem Textinhalt über den aktuellen Notenstand

Dim WSh As Worksheet

Dim sText As String, L As Long, sClass As String * 128

Dim Mailtext_2 As String
Dim Mailtext_1 As String

Dim objOutlook As Object
Dim objEmail As Object
Dim Mail As Object

Dim Kontrolle_0 As Date
Dim Kontrolle_1 As Date
Dim Kontrolle_2 As Date
Dim Kontrolle_3 As Date
Dim Kontrolle_4 As Date
Dim Kontrolle_5 As Date
Dim Kontrolle_6 As Date
Dim Kontrolle_7 As Date
Dim Kontrolle_8 As Date
Dim Kontrolle_9 As Date

Calculate

Set WSh = ThisWorkbook.Sheets("3AHET")  'Blatt mit Maildaten

Set objOutlook = CreateObject("Outlook.Application") 'E-Mail-Erstellung
Set objEmail = objOutlook.CreateItem(0) 'Neue E-Mail öffnen
Set Mail = objEmail

Kontrolle_0 = DateSerial(2020, 9, 30) 'Kontrollen(Datume) definieren
Kontrolle_1 = DateSerial(2020, 10, 12)
Kontrolle_2 = DateSerial(2020, 11, 18)
Kontrolle_3 = DateSerial(2020, 12, 31)
Kontrolle_4 = DateSerial(2021, 1, 31)
Kontrolle_5 = DateSerial(2021, 2, 28)
Kontrolle_6 = DateSerial(2021, 3, 31)
Kontrolle_7 = DateSerial(2021, 4, 30)
Kontrolle_8 = DateSerial(2021, 5, 31)
Kontrolle_9 = DateSerial(2021, 6, 30)

If Date = Kontrolle_0 Then 'Datum kontrollieren
GoTo Weiter
End If

If Date = Kontrolle_1 Then 'Datum kontrollieren
GoTo Weiter
End If

If Date = Kontrolle_2 Then 'Datum kontrollieren

GoTo Weiter
End If

If Date = Kontrolle_3 Then 'Datum kontrollieren
GoTo Weiter
End If

If Date = Kontrolle_4 Then 'Datum kontrollieren
GoTo Weiter
End If

If Date = Kontrolle_5 Then 'Datum kontrollieren
GoTo Weiter
End If

If Date = Kontrolle_6 Then 'Datum kontrollieren
GoTo Weiter
End If

If Date = Kontrolle_7 Then 'Datum kontrollieren
GoTo Weiter
End If

If Date = Kontrolle_8 Then 'Datum kontrollieren
GoTo Weiter
End If

If Date = Kontrolle_9 Then 'Datum kontrollieren
GoTo Weiter
End If

Exit Sub

'Weiter zur den E-Mail-Versendung

Weiter:

Shell "C:\Program Files\Microsoft Office\root\Office16\OUTLOOK" 'Outlook öffnen

'Schreibe die E-Mail Texte (max. 25 Zeilenumbrüche - &Chr(13)& or &Chr(10)& - Für nächste Zeile: Abstand _ )

Mailtext_2 = "Mathematik: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK14").Value & Chr(13) & _
"Note: " & WSh.Range("AN14").Value & Chr(13) & _
Chr(13) & _
"Energiesysteme: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK16").Value & Chr(13) & _
"Note: " & WSh.Range("AN16").Value & Chr(13) & _
Chr(13) & _
"Automatisierungstechnik: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK18").Value & Chr(13) & _
"Note: " & WSh.Range("AN18").Value & Chr(13) & _
Chr(13) & _
"Antriebtechnik: " & Chr(13) & _
"Punktestand: " & WSh.Range("AJ20").Value & Chr(13) & _
"Note: " & WSh.Range("AN20").Value & Chr(13) & _
Chr(13) & _
"CPE: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK22").Value & Chr(13) & _
"Note: " & WSh.Range("AN22").Value

Mailtext_1 = "Geografie: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK24").Value & Chr(13) & _
"Note: " & WSh.Range("AN24").Value & Chr(13) & _
Chr(13) & _
"Geschichte: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK26").Value & Chr(13) & _
"Note: " & WSh.Range("AN26").Value & Chr(13) & _
Chr(13) & _
"Industrieelektronik: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK28").Value & Chr(13) & _
"Note: " & WSh.Range("AN28").Value & Chr(13) & _
Chr(13) & _
"Naturwissenschaften: " & Chr(13) & _
"Punktestand: " & WSh.Range("AJ32").Value & Chr(13) & _
"Note: " & WSh.Range("AN32").Value & Chr(13) & _
Chr(13) & _
"Informatik: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK40").Value & Chr(13) & _
"Note: " & WSh.Range("AN40").Value


'E-Mail schreiben
With objEmail

Mail.To = "180178@studierende.htl-donaustadt.at"
Mail.Subject = "Noteninfo"
Mail.Body = "Aktueller Notenstand HTBLA22" & Chr(13) & _
Mailtext_2 & Mailtext_1

Mail.Display
Mail.send

End With

'Warteschleife um E-Mail zu senden
Application.Wait Now + TimeSerial(0, 0, 15) 'wartet 15 Sekunden
'E-Mail versendet!!!

'Alle Fenster durchscannen, um Outlook zu finden

hwnd = GetWindow(GetForegroundWindow(), GW_HWNDFIRST)
Do While hwnd <> 0
    L = GetWindowTextLength(hwnd) + 1
    sText = Space$(L)
    L = GetWindowText(hwnd, sText, L)
    If sText Like "Post*Outlook*" Then
      PostMessage hwnd, WM_CLOSE, 0&, 0&  'Outlook schließen
      Exit Sub
    End If
    DoEvents
    hwnd = GetWindow(hwnd, GW_HWNDNEXT)    'Handle des nächsten Fensters
Loop

End Sub



Wäre echt super wenn ihr mi helfen könnt!
Vielen Dank im Voraus!
Antworten Top
#2
Hallo,



Zitat:Hilfe!! Brauche Hilfe mit VBA


stimmt.  Blush Ohne die dazugehörige Datei wird das eher schwierig.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Antworten Top
#3
Hallöchen,

vor allem wäre eine genauere Problembeschreibung angesagt. Hier hast Du nur ein Problem beschrieben:

Zitat:Nur leider funktioniert manches nicht so! z.B dass er mir im E-Mail Text einfach die ersten paar Zeilen nicht schreibt.

und auch dabei steht die Frage, was die ersten paar Zeilen genau sind und was Du schon unternommen hast.
Sind es alle aus der variablen Mailtext_2 ?
Hast Du mal getestet, wenn Du nur die .._2 nimmst und die .._1 nicht? ...
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#4
Liebes Forum!
Im Anhang nochmals eine Leerdatei nur mit den entsprechenden Formeln. Wegen Datenschutzgründen
Hoffe es ist trotzdem verständlich


Angehängte Dateien
.xlsm   Clever-Excel-Forum_Notenübersicht.xlsm (Größe: 454,82 KB / Downloads: 4)
Antworten Top
#5
... ich habe auch mal den Betreff geändert. Hilfe braucht sicher jeder Fragesteller ...
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#6
Ich hoffe die Mailadresse im Code ist nicht echt?    Angel

Sieht aber echt aus. Im schlimmsten Fall ein aktiver Verteiler. 

@TE  du könntest den Code etwas übersichtlicher gestalten. Dann findet man auch die Zeile mit dem Fehler.
Ich bin hier auf Fehler gestoßen weil die Zellen mit Fehlerwerten  bestückt sind und die Value Eigenschaft der Range hier nicht so gut passt. Mit .Text läufts durch. 


PHP-Code:
Mailtext_2 "Mathematik: " Chr(13) & "Prozentstand: " WSh.Range("AK14").Text Chr(13)
Mailtext_2 Mailtext_2 "Note: " WSh.Range("AN14").Text Chr(13) & Chr(13)
Mailtext_2 Mailtext_2 "Energiesysteme: " Chr(13) & "Prozentstand: " WSh.Range("AK16").Text Chr(13
Antworten Top
#7
Hallo Marek,

was heißt: "die ersten Zeilen nicht schreibt".

Bei mir kommt der Fehler "Typen unverträglich" beim Setzen der Variablen Mailtext_1 und Mailtext_2.
Der Grund ist, dass die zu übernehmenden Werte aus Feldern stammen, deren Formel "#WERT" zurückgibt.
Also erst mal alle Formelfelder mit Fehlerabfang, z.B. =WENNFEEHLER oder =Istfehler, versehen.

Ansonsten läuft das Makro bei mir, es kann aber, wenn es Dir recht ist, noch etwas verkürzt werden, s. Code.

Vielleicht solltest Du auch anstatt Chr(13) auch besser vbLF also Chr(10) verwenden.

Code:

Option Explicit
Option Compare Text

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" ( _
        ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, _
        ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" ( _
       ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
       ByVal hwnd As LongPtr, ByVal lpString As String, _
       ByVal cch As Long) As Long
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Private Const WM_CLOSE = &H10
Dim hwnd As LongPtr
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2

Sub SendeMail()

'Sendet Monatlich eine E-Mail mit einem Textinhalt über den aktuellen Notenstand

 Dim WSh As Worksheet
 
 Dim sText As String, L As Long, sClass As String * 128
 
 Dim Mailtext_2 As String
 Dim Mailtext_1 As String
 
 Dim objOutlook As Object
 Dim objEmail As Object
 
 Dim Kontrolle_0 As Date
 Dim Kontrolle_1 As Date
 Dim Kontrolle_2 As Date
 Dim Kontrolle_3 As Date
 Dim Kontrolle_4 As Date
 Dim Kontrolle_5 As Date
 Dim Kontrolle_6 As Date
 Dim Kontrolle_7 As Date
 Dim Kontrolle_8 As Date
 Dim Kontrolle_9 As Date

 Calculate
 
 Set WSh = ThisWorkbook.Sheets("3AHET")  'Blatt mit Maildaten
 
 Set objOutlook = CreateObject("Outlook.Application") 'E-Mail-Erstellung
 Set objEmail = objOutlook.CreateItem(0) 'Neue E-Mail öffnen


 Kontrolle_0 = DateSerial(2020, 9, 30) 'Kontrollen(Datume) definieren
 Kontrolle_1 = DateSerial(2020, 10, 12)
 Kontrolle_2 = DateSerial(2020, 11, 18)
 Kontrolle_3 = DateSerial(2020, 12, 31)
 Kontrolle_4 = DateSerial(2021, 1, 31)
 Kontrolle_5 = DateSerial(2021, 2, 28)
 Kontrolle_6 = DateSerial(2021, 3, 31)
 Kontrolle_7 = DateSerial(2021, 4, 30)
 Kontrolle_8 = DateSerial(2021, 5, 31)
 Kontrolle_9 = DateSerial(2021, 6, 30)

'Datum kontrollieren
 Select Case Date
 Case Kontrolle_0, Kontrolle_1, Kontrolle_2, Kontrolle_3, Kontrolle_4
 Case Kontrolle_5, Kontrolle_6, Kontrolle_7, Kontrolle_8, Kontrolle_9
 Case Else: Exit Sub
 End Select

'Weiter zur den E-Mail-Versendung

 
 Shell "C:\Program Files\Microsoft Office\root\Office16\OUTLOOK" 'Outlook öffnen

'Schreibe die E-Mail Texte (max. 25 Zeilenumbrüche - &Chr(13)& or &Chr(10)& - Für nächste Zeile: Abstand _ )

Mailtext_2 = "Mathematik: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK14").Value & Chr(13) & _
"Note: " & WSh.Range("AN14").Value & Chr(13) & _
Chr(13) & _
"Energiesysteme: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK16").Value & Chr(13) & _
"Note: " & WSh.Range("AN16").Value & Chr(13) & _
Chr(13) & _
"Automatisierungstechnik: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK18").Value & Chr(13) & _
"Note: " & WSh.Range("AN18").Value & Chr(13) & _
Chr(13) & _
"Antriebtechnik: " & Chr(13) & _
"Punktestand: " & WSh.Range("AJ20").Value & Chr(13) & _
"Note: " & WSh.Range("AN20").Value & Chr(13) & _
Chr(13) & _
"CPE: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK22").Value & Chr(13) & _
"Note: " & WSh.Range("AN22").Value

Mailtext_1 = "Geografie: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK24").Value & Chr(13) & _
"Note: " & WSh.Range("AN24").Value & Chr(13) & _
Chr(13) & _
"Geschichte: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK26").Value & Chr(13) & _
"Note: " & WSh.Range("AN26").Value & Chr(13) & _
Chr(13) & _
"Industrieelektronik: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK28").Value & Chr(13) & _
"Note: " & WSh.Range("AN28").Value & Chr(13) & _
Chr(13) & _
"Naturwissenschaften: " & Chr(13) & _
"Punktestand: " & WSh.Range("AJ32").Value & Chr(13) & _
"Note: " & WSh.Range("AN32").Value & Chr(13) & _
Chr(13) & _
"Informatik: " & Chr(13) & _
"Prozentstand: " & WSh.Range("AK40").Value & Chr(13) & _
"Note: " & WSh.Range("AN40").Value


'E-Mail schreiben
With objEmail
  .To = "180178@studierende.htl-donaustadt.at"
  .Subject = "Noteninfo"
  .Body = "Aktueller Notenstand HTBLA22" & Chr(13) & _
   Mailtext_2 & Mailtext_1

  .Display
  .send
End With
 
'Warteschleife um E-Mail zu senden
Application.Wait Now + TimeSerial(0, 0, 15) 'wartet 15 Sekunden
'E-Mail versendet!!!

'Alle Fenster durchscannen, um Outlook zu finden

 hwnd = GetWindow(GetForegroundWindow(), GW_HWNDFIRST)
 Do While hwnd <> 0
    L = GetWindowTextLength(hwnd) + 1
    sText = Space$(L)
    L = GetWindowText(hwnd, sText, L)
    If sText Like "Post*Outlook*" Then
      PostMessage hwnd, WM_CLOSE, 0&, 0&   'Outlook schließen
      Exit Sub
    End If
    DoEvents
    hwnd = GetWindow(hwnd, GW_HWNDNEXT)    'Handle des nächsten Fensters
 Loop

End Sub

______________________
viele Grüße aus Freigericht
Karl-Heinz
Antworten Top
#8
Hallo,
Was ist eigentlich der genaue Unterschied zwischen &Chr(10)& und &Chr(13)&. 
Kann man nach Mailtext_1 = , auch einen Zeilenumbruch schreiben?
Das mit #Wert ist klar, denn ich habe die Noten davor rausgelöscht.
Vielleicht ist Excel manchmal verwirrt, denn er hat of geschrieben, dass die Variablen nicht definiert sind.
Das mit .Text ist natürlich besser. Habe .value genommen, weil ich diesen Begriff öfters im Internet gefunden habe.
Vielen vielen Dank für eure Hilfe!
Antworten Top
#9
10 und 13 sind CarriageReturn und LineFeed oder zu (alt - schreibmaschinen - ) deutsch Wagenrücklauf und Zeilenvorschub. Das war das, was früher auf den mechanischen Maschinen mit dem langen Hebelchen ausgelöst wurde Smile
Wenn DU in einer Excel-Zelle einen Zeilenumbruch einfügst nimmst Du 10 über ALT+ENTER oder bei einer Formel ZEICHEN(10)
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#10
Vielen Dank!
Kenne mich jetzt aus
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste