VBA Code Email mit PDF und Excel Anhang erstellen

[sam1976]

Hallo Leute habe gerade ein echtes Problem , 

und zwar habe ich eine Excel Tabelle die sich dynamisch erweitert mit der Zeit und da soll der Bereich 

A bis T als Anhang jeweils zu der Email hinzugefügt werden, dabei muss erkannt werden dann die Excel auch immer die neuen Zeilen beachtet die an Daten hinzugefügt werden. Zudem soll noch eine PDF über die gesamte Tabelle erstellt werden ..perfekt wäre auch da, dass da immer nur der befüllte Bereich angezeigt wird . Da wäre der Bereich (A bis AB)

ich habe eine VBA an sich fertig jedoch kann ich sie nicht durchtesten weil der Durchlauf immer an einer Stelle hängen bleibt !

.SaveAs Filename:=AWS, FileFormat:=xlOpenXMLWorkbook

ich bin leider absoluter Amateur und versuche mich da durch zu beißen jedoch komme ich hier einfach nicht weiter ...

für Hilfe wäre ich sehr sehr dankbar .. 

ich hänge den code an und hoffe auf Rückantwort . 

Vielen Dank . 

Code:

Sub UATEmailReporting2excelundpdfHTmLAuto()

'** Dimensionierung der Variablen
Dim strPDF As String
Dim OutlookApp As Object, strEmail As Object
Dim olOldbody As String
Dim olApp   As Object
  Dim AWS     As String


'** Vorgaben definieren
Set OutlookApp = CreateObject("Outlook.Application")
Set strEmail = OutlookApp.CreateItem(0)
AWS = Environ("USERPROFILE") & "\Desktop\Reporting-Outbound.xlsx"

'** PDF erzeugen
  ThisWorkbook.Sheets("Outbound").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  ThisWorkbook.Path & "\Reporting-Outbound.pdf", Quality:=xlQualityStandard _
  , IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _
  :=False
 
'** Excel erzeugen
ThisWorkbook.Sheets("Outbound").Range("A1:T" & Sheets("Outbound").Cells(Rows.Count, 1).End(xlUp).Row).Copy
 
  Application.DisplayAlerts = False
     With ActiveWorkbook
         .SaveAs Filename:=AWS, FileFormat:=xlOpenXMLWorkbook
         .Close savechanges:=False
     End With
  Application.DisplayAlerts = True

'** E-Mail versenden
strPDF = ThisWorkbook.Path & "\Reporting-Outbound.pdf"
Set olApp = CreateObject("Outlook.Application")
      With olApp.CreateItem(0)
With strEmail
.Attachments.Add strPDF
.Attachments.Add AWS
  .To = ""
  .Subject = "1000erKunden-Outbound-Report Stand:" & Range("AA1")
  .GetInspector
  olOldbody = .htmlBody
      .BodyFormat = 2 'olFormatHTML
      .htmlBody = "<font size=4 color=black name=Arial> <B>Hallo Zusammen,<BR><BR><BR>" _
            & "anbei das aktuelle </Font><font size=4 color=red name=Arial>Outbound-Reporting</Font> <font size=4 color=black name=Arial>inkl. aller Kundenreaktionen im Anhang.<BR><BR><BR>" _
            & "<B>Sollten sich Rückfragen zu dem Thema ergeben, gerne melden. </B><BR><BR>" _
            & olOldbody


 
  .Display
  '.Send 'Damit wir die E-Mail sofort versendet
  ' Kill strPDF
End With
 
'** Objektvariablen wieder löschen
Set OutlookApp = Nothing
Set strEmail = Nothing
End With

End Sub

[NobX]

Hallo,

Du kannst einmal folgendes versuchen:

- Anstelle  von: With AcitiveWorkbook .....With Sheets(Sheetname) im Code verwenden

- beim Dateinamen anstelle von AWS einmal mit "AWS" versuchen, da es sich um einen String handelt.

Oder besser eine Variable dimensioinieren z. B.
Dim strDatei As String
strDatei = "AWS"
.SaveAs Filename:=strDatei, FileFormat:=xlOpenXMLWorkbook                      '(die Variable benötigt keine """")

Grüße

NobX

[HKindler]

@NobX: Hast du dir den Code richtig angeschaut?

- AWS ist eine Stringvariable und korrekt definiert und belegt.

- ActiveWorkbook ist zwar prinzipiell nicht gut (man weiß nie, ob man wirklich das Workbook erwischt, das man haben will). Aber ein Workbook-Objekt durch ein Worksheet-Objekt zu ersetzen, ist jetzt auch nicht der Weisheit letzter Schluss. Hier wäre ThisWorkbook die richtige Variante.

[sam1976]

Erstmal vielen Dank für die Antworten jedoch hat es nichts an der Situation geändert weis aber auch nicht ob ich deine Anweisung richtig verstanden und umgesetzt habe . 

Mit der Bitte das optisch darzustellen .. 

ich weis dass meine VBA mal funktioniert hat ich weis nicht ob es Relevanz hat. dass die Datei im Sharepoint ist und ich die Datei immer in der App öffne um dann die Makro dann zu starten, jedoch bekomme ich die Laufzeit 1004 Fehlermeldung dass die Datei nicht  zugreifbar wäre ..der Fehler war vorher nicht.

Der Laufzeitfehler dass Windows auf die Datei nicht zugreifen kann bleibt bestehen, jetzt bin ich verwirrt. 
Habe da einfach auch zu wenig Ahnung von und werde auch in Zukunft die Finger von sowas lassen, 

nur wäre ich dankbar hier das Problem gelöst zu bekommen . 

das ist nun der Stand der Dinge 

Code:

Sub UATEmailReporting2excelundpdfHTmLAuto()

'** Dimensionierung der Variablen
Dim strPDF As String
Dim OutlookApp As Object, strEmail As Object
Dim olOldbody As String
Dim olApp   As Object
Dim AWS     As String


'** Vorgaben definieren
Set OutlookApp = CreateObject("Outlook.Application")
Set strEmail = OutlookApp.CreateItem(0)
AWS = Environ("USERPROFILE") & "\Desktop\Reporting-Outbound.xlsx"

'** PDF erzeugen
  ThisWorkbook.Sheets("Outbound").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  ThisWorkbook.Path & "\Reporting-Outbound.pdf", Quality:=xlQualityStandard _
  , IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _
  :=False
 
'** Excel erzeugen
ThisWorkbook.Sheets("Outbound").Range("A1:T" & Sheets("Outbound").Cells(Rows.Count, 1).End(xlUp).Row).Copy
 
  Application.DisplayAlerts = False
     With ThisWorkbook
         .SaveAs Filename:=AWS, FileFormat:=xlOpenXMLWorkbook   >>>>>>Problem!!!!!
         .Close savechanges:=False
     End With
  Application.DisplayAlerts = True

'** E-Mail versenden
strPDF = ThisWorkbook.Path & "\Reporting-Outbound.pdf"
Set olApp = CreateObject("Outlook.Application")
      With olApp.CreateItem(0)
With strEmail
.Attachments.Add strPDF
.Attachments.Add AWS
  .To = "bboehner@dela.de; kmehner@dela.de"
  .Subject = "1000erKunden-Outbound-Report Stand:" & Range("AA1")
  .GetInspector
  olOldbody = .htmlBody
      .BodyFormat = 2 'olFormatHTML
      .htmlBody = "<font size=4 color=black name=Arial> <B>Hallo Zusammen,<BR><BR><BR>" _
            & "anbei das aktuelle </Font><font size=4 color=red name=Arial>Outbound-Reporting</Font> <font size=4 color=black name=Arial>inkl. aller Kundenreaktionen im Anhang.<BR><BR><BR>" _
            & "<B>Sollten sich Rückfragen zu dem Thema ergeben, gerne melden. </B><BR><BR>" _
            & olOldbody


 
  .Display
  '.Send 'Damit wir die E-Mail sofort versendet
  ' Kill strPDF
End With
 
'** Objektvariablen wieder löschen
Set OutlookApp = Nothing
Set strEmail = Nothing
End With

End Sub

[HKindler]

Hi,

SharePoint ist natürlich so eine Sache, aber du willst ja auf dem Desktop speichern. Das sollte gehen.

Allerdings versucht du eine Datei mit Makros als *.xlsx-Datei zu speichern. Da kommt normalerweise eine Fehlermeldung. Also teste mal die Datei als *.xlsm zu speichern.

Code:

...
AWS = Environ("USERPROFILE") & "\Desktop\Reporting-Outbound.xlsm"   'oder Endung weg lassen, VBA macht das schon...
...
...
...
         .SaveAs Filename:=AWS, FileFormat:=xlOpenXMLWorkbookMacroEnabled
...

[sam1976]

Leider besteht der Fehler weiter hin sagt immer er kann auf die Datei nicht zugreifen unter User / Desktop/ xxxx

sollte man da den Pfad generell ändern? Auch das Hilft nicht wirklich ..

als ob die Datei blockiert ist oder nicht auffindbar aber ggf. ist auch die ganze VBA nicht ok!???

Zudem soll er ja nur das Registerblatt "Outbound" in dem angegebenen bestimmten Bereich abgreifen und daraus eine eigne Excel Datei machen und an die email anhängen

[volti]

Hallo,

da Du ja nur einen Ausschnitt und nicht ein ganzes Blatt exportieren möchtest, geht das m.E. so nicht.
Ich denke, Du musst den kopierten Bereich erst in neues Blatt kopieren und dieses dann exportieren.

Hier eine Idee dazu, die Du gerne mal ausprobieren kannst.

Wenn Du die Exceldatei auch nach Mailversand wieder löschen möchtest (wie die PDF) bietet sich als Speicherort auch das TEMP-Verzeichnis an....

Dein Mailcode war auch etwas konfus. Den habe ich (Einverständnis vorausgesetzt) mal ein wenig aufgeräumt

Code:

Option Explicit

Sub UATEmailReporting2excelundpdfHTmLAuto()
'** Dimensionierung der Variablen
  Dim strPDF As String, AWS As String

'** Vorgaben definieren
  AWS = Environ("USERPROFILE") & "\Desktop\Reporting-Outbound.xlsx"
 
  With ThisWorkbook.Sheets("Outbound")
'** PDF erzeugen
     strPDF = ThisWorkbook.Path & "\Reporting-Outbound.pdf"
     .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPDF, _
         Quality:=xlQualityStandard, IncludeDocProperties:=False, _
         IgnorePrintAreas:=False, OpenAfterPublish:=False
 
'** Excel erzeugen
     ThisWorkbook.Sheets.Add
     ActiveSheet.Name = "Outboundausschnitt"
     .Range("A1:T" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
     ActiveSheet.Paste
  End With
  Sheets("Outboundausschnitt").Copy
  
  Application.DisplayAlerts = False
  With ActiveWorkbook
      .SaveAs Filename:=AWS, FileFormat:=xlOpenXMLWorkbook
      .Close
  End With
  ThisWorkbook.Activate
  Sheets("Outboundausschnitt").Delete
  Application.DisplayAlerts = True

'** E-Mail versenden
  With CreateObject("Outlook.Application").CreateItem(0)
     .To = "bboehner@dela.de; kmehner@dela.de"
     .Subject = "1000erKunden-Outbound-Report Stand:" & Range("AA1")
     .BodyFormat = 2 'olFormatHTML
     .GetInspector.Display
     .htmlBody = "<font size=4 color=black name=Arial><b>Hallo Zusammen,<br><br><br>" _
               & "anbei das aktuelle <font color=red>Outbound-Reporting</Font> inkl. aller Kundenreaktionen im Anhang.<br><br><br>" _
               & "Sollten sich Rückfragen zu dem Thema ergeben, gerne melden.</b></font><br><br>" _
               & .htmlBody

     .Attachments.Add strPDF
     .Attachments.Add AWS
     Kill strPDF
  End With
End Sub

_________
viele Grüße
Karl-Heinz

[sam1976]

ich teste es mal eben..

mega ..hat geklappt .. vielen Dank dir!

[volti]

Hallo,

mir war jetzt doch Dein Verzeichnis wieder reingerutscht.
Eigentlich wollte ich ja das TEMP-Verzeichnis vorschlagen zum Zwischenspeichern.

Code:

Option Explicit

Sub UATEmailReporting2excelundpdfHTmLAuto()
'** Dimensionierung der Variablen
  Dim strPDF As String, AWS As String

'** Vorgaben definieren
  AWS = Environ("TEMP") & "\Reporting-Outbound.xlsx"
 
  With ThisWorkbook.Sheets("Outbound")
'** PDF erzeugen
     strPDF = Environ("TEMP") & "\Reporting-Outbound.pdf"
     .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPDF, _
         Quality:=xlQualityStandard, IncludeDocProperties:=False, _
         IgnorePrintAreas:=False, OpenAfterPublish:=False
 
'** Excel erzeugen
     ThisWorkbook.Sheets.Add
     ActiveSheet.Name = "Outboundausschnitt"
     .Range("A1:T" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
     ActiveSheet.Paste
  End With
  
  Sheets("Outboundausschnitt").Copy
  
  Application.DisplayAlerts = False
  With ActiveWorkbook
      .SaveAs Filename:=AWS, FileFormat:=xlOpenXMLWorkbook
      .Close
  End With
  ThisWorkbook.Activate
  Sheets("Outboundausschnitt").Delete
  Application.DisplayAlerts = True

'** E-Mail versenden
  With CreateObject("Outlook.Application").CreateItem(0)
     .To = "bboehner@dela.de; kmehner@dela.de"
     .Subject = "1000erKunden-Outbound-Report Stand:" & Range("AA1")
     .BodyFormat = 2 'olFormatHTML
     .GetInspector.Display
     .htmlBody = "<font size=4 color=black name=Arial><b>Hallo Zusammen,<br><br><br>" _
               & "anbei das aktuelle <font color=red>Outbound-Reporting</Font> inkl. aller Kundenreaktionen im Anhang.<br><br><br>" _
               & "Sollten sich Rückfragen zu dem Thema ergeben, gerne melden.</b></font><br><br>" _
               & .htmlBody

     .Attachments.Add strPDF
     .Attachments.Add AWS
     Kill strPDF
  End With
End Sub

_________
viele Grüße
Karl-Heinz