Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1764to1768
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

Doppelte Email

Doppelte Email
15.06.2020 10:10:59
Uli
Guten Morgen,
leider ich schon wieder.
Habe festgestellt das Outlook Mails immer doppelt versendet.
Sobald die Daten in dem Blatt Frühschicht abgesendet werden und im Blatt Action Plan eingehen im Bereich B7:B200 wird ein Makro zum Versand einer Email aufgerufen.
Wenn ich das Makro Email_an_PMV_077 manuell aufrufe versendet Outlook die Mail nur einmal
Klicke ich im Blatt Action Plan in Zelle B7 wird auch nur eine Mail versendet.
Sobald ich aber im Blatt Frühschicht das Makro Schreiben_PMV_Früh benutze. Also die Automatische Prozedur wird die Mail doppelt versendet.
Finde einfach den Fehler nicht.
Gruß Uli
Public Sub Schreiben_PMV_Früh()
Application.ScreenUpdating = False
'schreibt in geschlossene PMV
Dim sPfad         As String     ' der Ordner-Pfad der Excel-Mappen
Dim sDatei        As String     ' die zu beschreibende Datei
Dim WkSh_Q        As Worksheet  ' das Quell-Tabellenblatt - die Herkunft
Dim WkSh_Z        As Worksheet  ' das Ziel-Tabellenblatt - das Ergebnis
Dim ersteFreieZelle As Long
'Pfad User
'sPfad = "C:\Users\ElCapitan\Desktop\Prüflehren\"
'Pfad Uli
sPfad = ThisWorkbook.Path & "\"
sDatei = "PT05_FB_0001_Aktions- und Maßnahmenplan_MB.xlsm"
'         PT05_FB_0001_Aktions- und Maßnahmenplan_MB.xlsm
'Application.ScreenUpdating = False
If Dir(sPfad & sDatei, vbNormal)  "" Then
Workbooks.Open (sPfad & sDatei)
ThisWorkbook.Activate
'Application.ActiveWindow.Visible = False
Else
MsgBox "Den angegebenen Ordner """ & sPfad & """" & Chr(10) & _
"und/oder die gesuchte Datei """ & sDatei & """ gibt es nicht!", _
16, "   Hinweis für " & Application.UserName
Exit Sub
End If
Set WkSh_Q = ThisWorkbook.Worksheets("Frühschicht")
'alt
'Set WkSh_Z = Workbooks(sDatei).Worksheets("Action Plan_P992_077")
'neu
Set WkSh_Z = Workbooks(sDatei).Worksheets(WkSh_Q.Range("A74").Value)
ersteFreieZelle = WorksheetFunction.Max(7 - 1, WkSh_Z.Range("B29").End(xlUp).Row) + 1
WkSh_Z.Unprotect ""
WkSh_Q.Cells.Range("C74:E74").Copy Destination:=WkSh_Z.Range("B" & ersteFreieZelle & ":D" & _
ersteFreieZelle)
'datum in action plan schreiben
WkSh_Z.Range("B" & ersteFreieZelle) = Date
WkSh_Z.Protect ""
MsgBox "Die Daten wurden erfolgreich übergeben.", _
64, "   Information für " & Application.UserName
With WkSh_Z.Parent
.Save
.Saved = True
'.Close False
End With
Set WkSh_Q = Nothing: Set WkSh_Z = Nothing
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, Range("B7:B200")) Is Nothing _
Then Exit Sub
Call Email_an_PMV_078
End Sub
Sub Email_an_PMV_078()
Application.ScreenUpdating = False
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "XXXXXXXXXXXX"
.Subject = "Neuer Eintrag in Maßnahmenplan Prüflehren 078"
.Body = "Hallo. Es gibt ein neues Problem mit der Prüflehre P992_078 im Bereich Montage. Bitte öffnen Sie den Action und Maßnahmenplan im Ordner Prüflehren"
.Send 'Sendet die Email automatisch
End With
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Doppelte Email
15.06.2020 10:53:19
peterk
Hallo
Ich glaube du löst das Event Worksheet_Change 2x aus.
Hier änderst Du den Wert in Zelle B

WkSh_Q.Cells.Range("C74:E74").Copy Destination:=WkSh_Z.Range("B" & ersteFreieZelle & ":D" & _
ersteFreieZelle)
und hier nochmals

WkSh_Z.Range("B" & ersteFreieZelle) = Date

AW: Doppelte Email
15.06.2020 11:23:22
Luschi
Hallo Uli,
die Zauberbegriffen für dieses Phänomen heipen:
- Debugging mit
- F9, F8, Shift+F8, Strg+F8, F5 -Tastenkombinationen
Ursache: jedes Ändern von Zellinhalten per Vba löst das 'Worksheet_Change'-Event/Ereignisder jeweiligen Tabelle aus - Gegenmaßnamen:
- Debugging, Debugging u.n.m. Debugging
- gezieltes Verwenden von 'Application.EnableEvents = False' und danach wieder auf True setzen
- Google bzw. äquivalente Anbieter Deines Vertrauens als Suchinstrument nutzen
Gruß von Luschi
aus klein-Paris
Anzeige
Danke Luschi&Peter
15.06.2020 11:45:32
Uli
Hallo
Danke Luschi und Peter
hiermit funktioniert es dann wunderbar.
Application.EnableEvents = False
Set WkSh_Z = Workbooks(sDatei).Worksheets(WkSh_Q.Range("A74").Value)
ersteFreieZelle = WorksheetFunction.Max(7 - 1, WkSh_Z.Range("B29").End(xlUp).Row) + 1
WkSh_Z.Unprotect ""
WkSh_Q.Cells.Range("C74:E74").Copy Destination:=WkSh_Z.Range("B" & ersteFreieZelle & ":D" & _
ersteFreieZelle)
Application.EnableEvents = True

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige