Probleme nur Spalten per Email verschicken

[Daniel.Haering]

Hallo,

ich wollte ein Tabellenblatt per Email verschicken - funzt auch wunderbar mit diesem Code:

Code:

Sub einzelnes_Blatt_senden_Empfaenger()
'** Das aktive Tabellenblatt wird über Outlook versendet
'** Dimensionierung der Variablen
    Dim strBlatt As String
    Dim strDatei As String
    Dim strPfad As String
    Dim strDateiname As String
    Dim outObj As Object
    Dim Mail As Object
    Dim strBodyText As String
    Dim AnWenTo As String
    Dim AnWenCC As String
    Dim Betreff As String
   
    AnWenTo = Worksheets("Emailadressen").Range("B2").Value
    AnWenCC = Worksheets("Emailadressen").Range("B3").Value
    '** Email-Text festlegen
    strBodyText = "Emailtext"
    Set outObj = CreateObject("Outlook.Application")
    Set Mail = outObj.CreateItem(0)
    '** Pfad für temporäre Zwischenspeicherung angeben
    strPfad = "C:\Temp" 'entsprechend anpassen
    '** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
    strBlatt = ActiveSheet.Name
    '** Gewähltes Tabellenblatt kopieren
    Sheets(strBlatt).Copy
    '** Blatt temporär in vorgegebenes Verzeichnis abspeichern
    strDateiname = Sheets("Datenblatt").Range("A2").Value
    ActiveWorkbook.SaveAs strPfad & "\" & strDateiname
    '** Pfad und Dateiname der neuen Datei zwischenspeichern
    strDatei = ActiveWorkbook.FullName

   
   
'** Mail erzeugen
Betreff = Worksheets("Datenblatt_EG-8").Range("A2").Value
With Mail
.To = AnWenTo
.CC = AnWenCC
.Subject = Betreff '"Validierung zu Versuch" & Sheets("Gesetzesliste").Range("C11").Value 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With
'** Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close
'** Erzeugte Datei wieder löschen
Kill (strDatei)
'** E-Mail anzeigen
Mail.Display
End Sub

Funktioniert wunderbar - ich verschicke das aktuelle Tabellenblatt, nachdem ich das eh über eine Schaltfläche in dem Tabellenblatt aufrufe ist alles wunderbar.


Jetzt habe ich aber Tabellenblätter von denen nur die Spalten A bis D und auch eines von dem die Spalten A und D (und B & C nicht) verschickt werden sollen.

Ich habe jetzt schon versucht diese Zeilen anzupassen:

Code:

    '** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
    strBlatt = ActiveSheet.Name
    '** Gewähltes Tabellenblatt kopieren
    Sheets(strBlatt).Copy
    '** Blatt temporär in vorgegebenes Verzeichnis abspeichern
    strDateiname = Sheets("Datenblatt").Range("A2").Value
    ActiveWorkbook.SaveAs strPfad & "\" & strDateiname

und habe dazu die Copy-Zeile zu
    Worksheets(strBlatt).Range("A:D").Copy
etc. angepasst.

Das Problem ist dass ich dann die komplette Arbeitsmappe in den Temp-Ordner kopiert bekomme (und nicht mehr nur ein Tabellenblatt sondern eben die Date mit allen Tabellenblättern) und dass Excel abstürzt.

Ich wäre hier sehr dankbar wenn mir jemand weiterhelfen könnte - zur Not kann ich auch morgen noch eine Beispieldatei basteln, das wird aber so viel Aufwand dass ich mir das gerne sparen würde....

Schönen Abend
 Daniel

[Winny]

Hi

nachdem Du das zu versendende Blatt kopiert und gespeichert hast kannst Du es bearbeiten und dann schliessen wobei es nochmal gespeichert wird

Code:

.
.
.
   Sheets(strBlatt).Copy
   ActiveWorkbook.SaveAs strPfad & "\" & strDateiname
   '** Pfad und Dateiname der neuen Datei zwischenspeichern
   strDatei = ActiveWorkbook.FullName
   ActiveSheet.Columns("B:C").ClearContents
   ActiveWorkbook.Close SaveChanges:=True
.
.
.

Danach geht es weiter mit dem Versenden als Anhang.

[Daniel.Haering]

An der Stelle noch ein herzliches Dankeschön - mit dem Code funktioniert es so wie es soll!

Grüße
 Daniel