Mit Excel 2010 funktionierts nicht, mit Excel 2016 funktionierts...wo ist den fehler?

[Niko]

Hallo an alle,

Vorab wünsche ich allen frohe Feiertage, mit viel Freude, Liebe und Gesundheit .
 
Habe den beigelegten Code im mein Arbeitsblatt kopiert und mit Win 10 & Excel 2016 funktioniert alles ohne Problem.
Wenn ich auf meines Kollegen den PC mit Win7 & Excel 2010 dasselbe abspiele funktioniert es nicht. Da kommt Laufzeitfehler 1004.
 
Der VBA code sendet ein einzelnes Blatt per E-Mail.
 
Weiß nicht wo ich den Fehler mache!! ??

Code:

Sub Excel_Sheet_via_Outlook_JanKol()
Me.Unprotect ("1234")
Dim GruppenName, KollegenMonat As String
GruppenName = ThisWorkbook.Sheets("DPV1").Range("A3")
KollegenMonat = Month(CDate(ThisWorkbook.Sheets("DPV1").Range("B1"))) & "/" & Year(CDate(ThisWorkbook.Sheets("DPV1").Range("B1")))
   Dim MyMessage As Object, MyOutApp As Object
   Dim SavePath As String
   Dim AWS As String
   SavePath = "C:"
   Worksheets("DPV1").Copy
   ActiveSheet.UsedRange.Copy
   ActiveSheet.Cells().PasteSpecial xlPasteValues
   ActiveWorkbook.SaveAs SavePath & "\" & ActiveSheet.Name & "_" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"
   With ActiveWorkbook
       AWS = .FullName
       .Close
   End With
   Set MyOutApp = CreateObject("Outlook.Application")
   Set MyMessage = MyOutApp.CreateItem(0)
   With MyMessage
       .To = "My.Kollegen@mail.de"
       .Subject = "Dienstplan - Gruppe: " & GruppenName & " - Monat: " & KollegenMonat & " - " & Date & "-" & Time
       .Attachments.Add AWS
    
       'Hier wird die HTML Mail erstellt
       .Body = "Liebe Kollegen," & vbCrLf & vbCrLf & "Im Anhang dieser E-Mail befindet sich der Dienstplan unser Gruppe in Form einer Excel Datei." & vbCrLf & "Die Datei wird automatisch generiert, bitte beim Aufmachen der Datei alle Vormeldungen zu akzeptieren/aktivieren." & vbCrLf & vbCrLf & "Zu öffnen mit dem MS Excel Programm oder einem Excel kompatiblen Programm." & vbCrLf & vbCrLf & vbCrLf & "Vielen Dank," & vbCrLf & GruppenName & ""
       'Hier wird die Mail nochmals angezeigt
       .GetInspector     ' sorgt für die Signatur
       .Display
       'Hier wird die Mail gleich in den Postausgang gelegt
       '.Send
       'Hier wird die temporäre Datei wieder gelöscht
       Kill AWS
   End With
   'MyOutApp.Quit
   Set MyOutApp = Nothing
   Set MyMessage = Nothing
   Me.Protect ("1234")
End Sub

Anbei die Datei:
  e-mail per sheet TEST.xlsm (Größe: 37,41 KB / Downloads: 7)

Danke,

Niko

[Gast 123]

Hallo Niko

der Fehler dürfte schwierig zu finden sein, aber es ist nişcht unmöglich.  Probieren wir es mal!

Das Makro befindet sich in einer Tabelle, nicht im normalen Modul. Das hat meistens das Problem das man den Laufzeitfehler im Code nicht angezeigt bekommt!  D.h., gelb markierte Zeile!  Kopiere das Makro bitte in ein normales Modul, lösche es in der Tabelle, und lasse es im Modul mit F5 laufen. 

Wenn du Glück hast bekommst du die defekte Zeile angezeigt. Darauf könnten dir andere Kollegen einen Rat geben, denn E-Mail senden habe ich nie gemacht. Da gibt es aber Kollegen die sich damit auskennen, wenn du uns die defekte Zeile angeben kannst.

mfg  Gast 123

[Niko]

Danke für den Tipp

Habe es probiert und es zeigte denn fehler an den befehl " Me.Unprotect ("1234") " habe ihn umgeschrieben auf " ActiveWorkbook.ActiveSheet.Unprotect ("1234") " und geht durch.
Doch es kommt ein neuer fehler auf der mir sagt das es ein problem mit dem abruf des speicherplatzes zu tun hatt, das über 256 zeichen zu viel sind...doch es zeigt mir nicht in welcher zeile der fehler liegt.

Wie auch immer, wenn sich einer mit den unterschieden in den befehlen zwischen Excel 2010 und 2016 kennt, Bitte helfen :75:



Danke,
Niko

[schauan]

Hallöchen,

die Fehler haben m.E. nix mit Unterschieden zwischen 2010 und 2016 zu tun.
Für einen Fehler allgemein wäre es von Vorteil, wenn Du auch die Zeile nennst, wo er auftritt.

Falls es de Zeile mit SaveAs ist - das Problem mit den 256 Zeichen kann z.B. mit einem zu langen Dateinamen zusammenhängen.

Außerdem mögen es manche Rechner nicht, irgendwelche beliebigen Dateien direkt auf C:\ zu speichern. Da sollte aber ein anderer Fehler kommen.

[LuckyJoe]

Hallo zusammen,

ich habe das Makro mal auf Windows 7 mit Office 2003 ausprobiert: es läuft ohne Probleme, so dass es an der Version nicht liegen kann.
Könnte es an "Extras - Verweise" liegen? Bei mir sind hier eingerichtet:

• Visual Basic for Applications
  
• Microsoft Excel 11.0 Object Library
  
• Microsoft Office 11.0 Object Library
  

• OLE Automation
  

Wünsche viel Erfolg.

[maninweb]

Hallo,

bei mir funktionierte beides nicht, also weder in Excel 2016 noch in Excel 2010. Neben der Anmerkung von schauan,
dass oft gar nicht auf C:\ gespeichert werden darf, beziehst Du Dich auf's aktive Blatt nach der Kopieraktion. Das
kann zu unverhergesehenen Ergebnissen führen.

Ersetze mal ...

Code:

ActiveWorkbook.SaveAs SavePath & "\" & ActiveSheet.Name & "_" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"
With ActiveWorkbook

durch (Quick & Dirty) ...

Code:

Application.Workbooks(Application.Workbooks.Count).SaveAs ThisWorkbook.Path & "\" & "DPV1" & "_" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"
With Application.Workbooks(Workbooks.Count)

Gruß

[LuckyJoe]

Wenn die angelegte Datei ohnehin nur temporär ist und sofort wieder gelöscht wird, warum dann nicht gleich in das Temp-Verzeichnis des Systems verlegen?

Code:

SavePath = Environ("TEMP")

[Niko]

Hallo an alle,
 
Vielen Dank für eure Vorschläge.
Nach euren vorgeschlagenen Änderungen funktioniert es ohne Probleme auch bei Excel 2010
 
Eine letzte bitte habe ich noch , ist es möglich das Arbeitsblatt ohne Verknüpfungen und Funktionen in die E-Mail einzufügen/Kopieren?
 

Code:

Sub Excel_Sheet_via_Outlook_JanKol()
ActiveWorkbook.ActiveSheet.Unprotect ("1234")
Dim GruppenName, KasseMonat As String
GruppenName = ThisWorkbook.Sheets("DPV1").Range("A3")
KasseMonat = Month(CDate(ThisWorkbook.Sheets("DPV1").Range("B1"))) & "/" & Year(CDate(ThisWorkbook.Sheets("DPV1").Range("B1")))
   Dim MyMessage As Object, MyOutApp As Object
   Dim SavePath As String
   Dim AWS As String
   SavePath = SavePath = Environ("TEMP")
   Worksheets("DPV1").Copy
   ActiveSheet.UsedRange.Copy
   ActiveSheet.Cells().PasteSpecial xlPasteValues
   Application.Workbooks(Application.Workbooks.Count).SaveAs ThisWorkbook.Path & "\" & "DPV1" & "_" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"
With Application.Workbooks(Workbooks.Count)
       AWS = .FullName
       .Close
   End With
   Set MyOutApp = CreateObject("Outlook.Application")
   Set MyMessage = MyOutApp.CreateItem(0)
   With MyMessage
       .To = "My.Kollegen@mail.de"
       .Subject = "Dienstplan - Gruppe: " & GruppenName & " - Monat: " & KasseMonat & " - " & Date & "-" & Time
       .Attachments.Add AWS
       .Body = "Liebe Kollegen," & vbCrLf & vbCrLf & "Im Anhang dieser E-Mail befindet sich der Dienstplan unser FG in Form einer Excel Datei." & vbCrLf & "Die Datei wird automatisch generiert, bitte beim Aufmachen der Datei alle Vormeldungen zu akzeptieren/aktivieren." & vbCrLf & vbCrLf & "Zu öffnen mit dem MS Excel Programm oder einem Excel kompatiblen Programm." & vbCrLf & vbCrLf & vbCrLf & "Vielen Dank," & vbCrLf & GruppenName & ""
       'Hier wird die Mail nochmals angezeigt
       .GetInspector     ' sorgt für die Signatur
       .Display
       'Hier wird die Mail gleich in den Postausgang gelegt
       '.Send
       'Hier wird die temporäre Datei wieder gelöscht
       Kill AWS
   End With
   'MyOutApp.Quit
   Set MyOutApp = Nothing
   Set MyMessage = Nothing
   ActiveWorkbook.ActiveSheet.Protect ("1234")
End Sub

Zimt, Koriander, Kokosnuss,
was für Düfte
schweben durch die Lüfte.
Weihnachtsbäckerei,
Festtagsschlemmerei.
Für jeden etwas dabei.
So sei auch diese Weihnachtsfeierei.
Eine schöne Weihnachtszeit an euch allen und eure Familie.

Danke,

Niko

[Niko]

Zur meiner frage ...zusätzlich



Ist es möglich das Arbeitsblatt ohne Verknüpfungen und Funktionen in die E-Mail einzufügen/Kopieren?

Wie kann ich "Range" des kopierten Blattes angeben?

Statt

Code:

ActiveSheet.UsedRange.Copy

kann ich ActiveSheet.Range(A3:H60) eingenben?

[snb]

Code:

Sub M_snb()
   With ThisWorkbook.Sheets("DPV1")
      sn = Array(.Range("A3"), Format(.Range("B1"), "m_yyyy"), Application.TemplatesPath & "neu.xlsb")
      .Copy
    End With
    
    With ActiveWorkbook
       .Sheets(1).UsedRange.value = .Sheets(1).UsedRange.Value
       .SaveAs sn(2), 50
       .Close
    End With
   
   With CreateObject.CreateItem(0)
       .To = "My.Kollegen@mail.de"
       .Subject = "Dienstplan - Gruppe: " & sn(0) & " - Monat: " & sn(1) & " - " & now
       .Attachments.Add sn(2)
       .Body = "Öffnen auf eigenem Gefahr"
       .Send
   End With
End Sub