Guten Morgen in die Runde. Komme nochmal mit einer Bitte bezüglich "mit Outlook versenden". Ich möchte Änderungen die in einer Tabelle vorgenommen werden in eine separate Datei speichern und dann als Word-Dokument mittel Outlook an eine Mail-Adresse direkt versenden. Dies gelingt mir mit meinem Code bis zu dem Punkt wo das Word-Dokument versendet werden soll. Dann erfolgt Fehlermeldung Code 91, Objekt variable o. With. Blockvariable s. u. nicht festgelegt.
Die Fehlerzeile: .To = "############@gmail.com"
Mein mit viel Mühe zusammengestellter Code:
Die Fehlerzeile: .To = "############@gmail.com"
Mein mit viel Mühe zusammengestellter Code:
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim lngLast As Long
Dim irow As Long
Dim lngzeilemax As Long
Dim rngZelle As Range ' Objekt ' Integer 'Range ' Integer ' Long
Dim von As Long
Dim tempwert
Application.EnableEvents = True
If inarbeit = True Then Exit Sub
If Not Intersect(Target, Range("A2:A500")) Is Nothing Then
inarbeit = True
' If Target.Value <> "" Then
irow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(irow, "G").NumberFormat = "General"
Cells(irow, "O").NumberFormat = "General"
Cells(irow, "G").FormulaLocal = "=WENN($H" & irow & "<>"""";INDEX(PLZ!$A:$A;VERGLEICH($H" & irow & ";PLZ!$C:$C;0));"""")"
Cells(irow, "O").FormulaLocal = "=WENN(UND(M" & irow & "<>""p"";M" & irow & "<>""sz"";M" & irow & "<>"""");M" & irow & "-HEUTE();"""")"
Cells(irow, "P").FormulaLocal = "=WENN(J" & irow & "="""";"""";DATEDIF(J" & irow & ";HEUTE();""Y""))"
Cells(irow, "Q").FormulaLocal = "=WENN(K" & irow & "="""";"""";DATEDIF(K" & irow & ";HEUTE();""Y""))"
Cells(irow, "R").FormulaLocal = "=WENN($H" & irow & "<>"""";INDEX(PLZ!$B:$B;VERGLEICH($H" & irow & ";PLZ!$C:$C;0));"""")"
Cells(irow, "Y").FormulaLocal = "=WENN($N" & irow & "="""";"""";WENN($N" & irow & "<10;""WG"";WENN(UND($N" & irow & ">=15;$N" & irow & "<=18);""TG"";"""")))"
Cells(irow, "Z").FormulaLocal = "=WENN($Y" & irow & "=""TG"";""42"";WENN($Y" & irow & "=""WG"";""84"";WENN($Y" & irow & "="""";"" "")))"
Cells(irow, "AB").FormulaLocal = "=WENN(M" & irow & "="""";"""";TEXT(M" & irow & ";""JJJJ.MM.TT""))"
Cells(irow, "AC").FormulaLocal = "=Wenn(J" & irow & "="""";"""";TEXT(J" & irow & ";""MM.TT""))"
Cells(irow, "AD").FormulaLocal = "=WENN($J" & irow & "<>"" "";BRTEILJAHRE($J" & irow & ";HEUTE()))"
Cells(irow, "AE").FormulaLocal = "=WENN($AD" & irow & "<>"" "";AUFRUNDEN($AD" & irow & ";0);"" "")"
If Cells(irow, 14).Value = "20" Then ' Wenn in den Zeilen der Spalte 14 ein "SZ" steht
Cells(irow, 22) = "'++++" ' dann soll in den Zeilen Spalte 22 und 23 das Pluszeichen eingefüht werden
Cells(irow, 23) = "'++++"
Cells(irow, 26) = "'"
ElseIf Cells(irow, 21).Value = "SZ" Then ' Wenn in den Zeilen der Spalte 21 ein "SZ" steht
Cells(irow, 22) = "'++++" ' dann soll in den Zeilen Spalte 22 und 23 das Pluszeichen eingefüht werden
Cells(irow, 23) = "'++++"
ElseIf Cells(irow, 21).Value = "" Then ' Wenn in den Zeilen der Spalte 21 ein " " steht
Cells(irow, 22) = "20€" ' dann soll in der Spalte 22 die "20,22€" eingefüht werden
End If
inarbeit = True
End If
'** WENN der folgende Code eigenständig gestartet wird wir die Tabelle "Info" korrekt mit Daten Alt und Neu
'** gefüllt!
If Not ausuf Then
inarbeit = True
tempwert = Target.Value
' Application.Undo
mvntWert = Target.Value
Target = tempwert
inarbeit = False
End If
'**End With
Set wks = Worksheets("Info")
lngLast = wks.Range("A65536").End(xlUp).Row + 1
If Target.Count > 1 Then
Exit Sub
End If
If Intersect(Range("A2:AE320"), Target) Is Nothing Then
Exit Sub ' bei dem Befehl steigt er aus wenn nichts in der Zelle drin ist/war
End If
With wks 'alles was hier kommt un mit einem Punkt beginnt betrifft das Worksheet
.Range("A" & lngLast).Value = Target.Address(0, 0)
.Range("B" & lngLast).Value = mvntWert 'und was ist das für ein Wert? woher kommt der? hier ist er leer
.Range("C" & lngLast).Value = Target.Value 'hier greifst du auf den Wert des Ranges zu
.Range("D" & lngLast).Value = VBA.Environ("Username")
.Range("E" & lngLast).Value = Now
mvntWert = "" 'wozu den Leerstring? In der Variablen ist nichts drin. wird auch nirgendwo was zugewiesen
Set rngZelle = Target
Open ThisWorkbook.Path & "\Aenderungen.docx" For Append As #1 'Ich würde in VBA-Code auch bei Dateinamen auf Umlaute verzichten
Print #1, "letzte Änderung:" & Now & von & Environ("username")
Print #1, rngZelle.Parent.Name & ", " & rngZelle.Address & ", " & rngZelle.Value
Close #1
End With
' End Sub
' Wenn ab hier separat gestartet wir läuft er durch.
' Senden per EMail allerdings nicht.
' Tabelle aus Excel nach Word kopieren
' Sub WordTabelleSchreiben2()
Dim appWord As Object, tb As Object, wordDoku As Object
Dim excelTabelle As Range, wordbereich As Object
Dim letzteZeile As Integer, letzteSpalte As Integer, Mail As Range
Set excelTabelle = ThisWorkbook.Worksheets("Info").UsedRange
excelTabelle.Copy
Worksheets("Info").Range("A1:F40").Copy ' ActiveSheet.Range("A1")
' Neues Word-Dokument erstellen
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
Set wordDoku = appWord.Documents.Add
Set wordbereich = wordDoku.Paragraphs.last.Range
wordDoku.Paragraphs(1).Range.Paste
' Anwendung "Word" beenden
' appWord. Quit
appWord.Visible = True
wordbereich.Style = "Kein Leerraum" ' Hiermit die Textformatierung "Kein Leerraum" bestimmen.
wordDoku.PageSetup.Orientation = 1
' End Sub
' Hier soll die WORD-Tabelle per Outlook versandt werden
' Public Sub TableToMail() ' Das hat funftioniert!!!!!
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With Mail
.To = "############@gmail.com"
.Subject = "Datenaktualisierung"
.Attachments.Add "C:UsersBesitzerDesktopAenderungen.docx"
.Body = "Anbei meine aktualisierten Datensätze. Vielen Dank."
.Display
.Send ' = Nachricht direkt senden
End With
' Set objol = Nothing
End Sub
fad
