[Excel] Tabelle mit Outlook versenden

josef24

Erfahrenes Mitglied
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:

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
 
Ganz einfach
Visual Basic:
'Du setzt die Varable objMail
Set objMail = objOutlook.CreateItem(0)
'Und hier heisst sie auf einmal Mail, sollte aber obMail heissen
With Mail

Gemäss deiner Definition ist Mail ein Range
Code:
Dim letzteZeile As Integer, letzteSpalte As Integer, Mail As Range
 
Danke erstmal. Habe deinen Vorschlag umgesetzt. Es wird mir jetzt eine E-Mail aufbereitet, was aber fehlt ist das Word-Dokument. Habe Probleme mit dem Speichern der EXCEL Datei unter Word, und dann die Übernahme in die Outlook Mail als Anhang. Mein Code von wo aus ich es probiert habe. Gruß Josef

Visual Basic:
  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 Object

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")

        Set wordDoku = appWord.Documents.Add
        Set wordbereich = wordDoku.Paragraphs.last.Range
   
wordDoku.Paragraphs(1).Range.Paste

    ' Anwendung "Word" beenden
    ' appWord. Quit
    appWord.Visible = False  '  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
           
            Set objOutlook = CreateObject("Outlook.Application")
            Set Mail = objOutlook.CreateItem(0)
        With Mail
       
         .To = "###########@gmail.com"
        .Subject = "Datenaktualisierung"
'        .Attachments.Add "C:UsersBesitzerDesktopAenderungen.doc"
        .Body = "Anbei meine aktualisierten Datensätze. Vielen Dank."
        .Display
        .Send      ' = Nachricht direkt senden
    End With
   
     '  Set objol = Nothing

End Sub
 
Zuletzt bearbeitet von einem Moderator:
Du fügst auch kein Attachment an.
Falls die Auskommentierte Zeile dein Versuch war, Windows arbeitet immer noch mit C:\pfad und nicht mit C:pfad

Und bitte, Formatiere dein Coide, das Chaos kann man ja nicht lesen!
 
Hallo und guten Morgen. Danke für den Hinweis, habe die Korrektur vorgenommen und das Senden der Mail ist perfekt. Sorry, aber vielleicht kann man die Unordnung in der Formatierung ignorieren. Bei meinen Versuchen geht das mit der Formatierung schonmal unter. Aber ist trotzdem bei dem Attachment eine Ergänzung des Codes für das Anhängen des Word-Dokuments möglich? Vielleicht geht da ja noch etwas. Gruß Josef
Fehler: Datei kann nicht gefunden werden: hier mein Versuch einen Anhang von Tabellenblatt "Info":

Code:
.Attachments.Add "C:/Info.xlsm"

Hier der Fehler:
Code:
Set myItem = Application.CreateItem(olMailItem)

Der Codeversuch insgesamt:
Code:
Public Sub TableToMail() ' Das hat funftioniert!!!!!
            
            Dim objOutlook As Object, myItem As Object
            Dim objMail As Object, myAttachments As Object
             Dim Attachments As Outlook.Attachments
            
            Set objOutlook = CreateObject("Outlook.Application")
            Set objMail = objOutlook.CreateItem(0)
            
          With objMail
        
            .To = "wculmus@gmail.com"
            .Subject = "Datenaktualisierung"
        
         ' Versuch 1 Datei anzuhängen
             Set myItem = Application.CreateItem(olMailItem)
             Set myAttachments = myItem.Attachments
             myAttachments.Add "C:\pfad UsersBesitzerDesktopAenderungen.doc"
            
         ' Versuch 2 Datei anzuhängen
         '***  Attachments.Add "C:\pfad UsersBesitzerDesktopAenderungen.doc"
         '    .Attachments.Add "C:/Info.xlsm"
         '    .myAttachments.Add "C:\Users\Besitzer\Desktop\TEST_OUTLOOK_Sonntag_11.00.docx.xlsm"
        
         .Body = "Anbei meine aktualisierten Datensätze. Vielen Dank."
        .Display
        .Send      ' = Nachricht direkt senden
    End With
    
       ' Set objol = Nothing

End Sub
 
Zuletzt bearbeitet:
Hallo, lasse meine Antwort von gestern mal so stehen. Aber mir kam gestern Abend die Idee, das ich doch nicht erst nach Word kopieren, sondern direkt die Tabelle "Info" an die Mail anhängen könnte. Dies würde den Code sicherlich vereinfachen. Ich habe jetzt die Tabelle "Info" in der E_Mail angehängt, die für sich separat gestartet auch funktioniert. Wenn ich den Code allerdings komplett s. u. (letzter Code) starte wird er nicht mit einbezogen. Für den Code richtig als eine "Einheit" zu starten bräuchte bitte Unterstützung. Danke und Gruß Josef

Code:
Sub PDFundSENDEN()
ChDir "C:\Users\Besitzer\Desktop"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Besitzer\Desktop\testPDF.pdf", OpenAfterPublish:=True

Dim Outlook As Object
Dim OutlookMailItem As Object
Dim myAttachments As Object
Dim OutlookApp As Object
Dim bereich As Range
Dim wks As Worksheet

    '  so habe ich jetzt die Tabelle mit den Änderungen

    ThisWorkbook.Worksheets("Info").Cells(1, 1).CurrentRegion

Set OutlookApp = CreateObject("outlook.application")
Set OutlookMailItem = OutlookApp.CreateItem(0)
Set myAttachments = OutlookMailItem.Attachments

With OutlookMailItem
.To = ("##########@gmail.com")
.Subject = ("TestMail_A1")
.Body = "Die EXCEL Datei ist als PDF beigefügt."
myAttachments.Add "C:\Users\Besitzer\Desktop\testPDF.pdf"
.Send
' .Display
End With

Set OutlookApp = Nothing
Set OutlookMailItem = Nothing

End Sub

Der gesamte Code:
 
Zuletzt bearbeitet:
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

If Not ausuf Then
    inarbeit = True
    tempwert = Target.Value
    Application.Undo
    mvntWert = Target.Value
    Target = tempwert
    inarbeit = False
End If

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

Sub PDFundSENDEN()

ChDir "C:\Users\Besitzer\Desktop"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Besitzer\Desktop\testPDF.pdf", OpenAfterPublish:=True

Dim Outlook As Object
Dim OutlookMailItem As Object
Dim myAttachments As Object
Dim OutlookApp As Object
Dim bereich As Range
Dim wks As Worksheet

ThisWorkbook.Worksheets("Info").Cells(1, 1).CurrentRegion

Worksheets("Info").Copy After:=Worksheets(Worksheets.Count)
Worksheets("Info").Range("A1:F25").Copy '  ActiveSheet.Range("A1")

Set OutlookApp = CreateObject("outlook.application")
Set OutlookMailItem = OutlookApp.CreateItem(0)
Set myAttachments = OutlookMailItem.Attachments

With OutlookMailItem
.To = ("###########@gmail.com")
.Subject = ("TestMail_A1")
.Body = "Die EXCEL Datei ist als PDF beigefügt."
myAttachments.Add "C:\Users\Besitzer\Desktop\testPDF.pdf"
.Send
' .Display
End With

Set OutlookApp = Nothing
Set OutlookMailItem = Nothing

End Sub
 
Zuletzt bearbeitet:
Was willst du von uns? Dass wir viele Zeilen unformatierten chaotischen Code lesen?
Nein, ich tu mir dass nicht an, bin kein Maso.
1) Formatiere dein COde, damit er lesbar wird
2) Verwende VB-Code-Tags im FOrum, damit er der Code im Forum farblich dargestellt wird.

Was ist der Unterschied zwischen deinem Letzten und vorletzten Post?
Ich habe jetzt die Tabelle "Info" in der E_Mail angehängt, die für sich separat gestartet auch funktioniert. Wenn ich den Code allerdings komplett s. u. (letzter Code) starte wird er nicht mit einbezogen. Für den Code richtig als eine "Einheit" zu starten bräuchte bitte Unterstützung. Danke und Gruß Josef
Was für ein Code soll wo mit einbezogen werden? Was ist eine Einhgeit?
 
Hallo, fürs bessere Verständnis muß ich folgendes anmerken. Der Codeanteil (1ter Abschnitt) läuft, wenn ich ihn separat starte. Nun versuche ich den 2ten Teil des Code (Sub PDFundSENDEN() ) unmittelbar an den ersten anzuschließen, damit er dann die Tabelle "in einem Atemzug" per Outlook sendet.
Ich hoffe es jetzt einigermaßen verständlich erklärt zu haben. Vielen Dank bis dahin und Gruß Josef
End With End Sub [I]' Ab hier soll der folgende Code mit eingebunden werden.[/I] Sub PDFundSENDEN() ChDir "C:\Users\Besitzer\Desktop" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\Besitzer\Desktop\testPDF.pdf", OpenAfterPublish:=True Dim Outlook As Object Dim OutlookMailItem As Object Dim myAttachments As Object Dim OutlookApp As Object Dim bereich As Range Dim wks As Worksheet ThisWorkbook.Worksheets("Info").Cells(1, 1).CurrentRegion Worksheets("Info").Copy After:=Worksheets(Worksheets.Count) Worksheets("Info").Range("A1:F25").Copy ' ActiveSheet.Range("A1") Set OutlookApp = CreateObject("outlook.application") Set OutlookMailItem = OutlookApp.CreateItem(0) Set myAttachments = OutlookMailItem.Attachments With OutlookMailItem .To = ("###########@gmail.com") .Subject = ("TestMail_A1") .Body = "Die EXCEL Datei ist als PDF beigefügt." myAttachments.Add "C:\Users\Besitzer\Desktop\testPDF.pdf" .Send ' .Display End With Set OutlookApp = Nothing Set OutlookMailItem = Nothing End Sub
 
Sorry, unlesbar. Ich weigere mich den unformatierten Code überhaubt zu lesen.
Es ist das A und O des Programmierens. Die Anderen können das auch und dubist ja nicht mehr unerfahren.

Erster Abschnitt ist bei der End With.
Zweiter Abschnitt End Sub.
Du schreibst, dass der Erste Abschnitt läuft. Nein, tut er nicht. Ein End With ohne einen passenden Start funktioniert nicht.
 
Zurück