VBA Code
29.04.2020 15:05:39
Chris
ich stehe gerade auf dem Schlauch mit dem zusammenfügen zweier VBA Codes, die jeweils mit einem Formularsteuerelement (Button) gestartet. Nun möchte ich den Code von nur einem Button aus starten lassen. Ich habe mit meinen bescheidenen Fähigkeiten bereits alles versucht, bekomme jedoch ständig Fehlermeldungen (Fehler beim Kompilieren, als Beispiel).
Kann mir jemand weiterhelfen bevor ich ganz verzweifel?
1.
Private Sub CommandButton1_Click()
'Kopieren der Daten für die Umschläge
Worksheets("Auswahllisten").Range("G2:G105").Copy
Worksheets("Daten Umschläge").Range("A2").PasteSpecial xlPasteValues
Worksheets("Eingabetabelle").Range("H2:H105").Copy
Worksheets("Daten Umschläge").Range("B2").PasteSpecial xlPasteValues
Worksheets("Eingabetabelle").Range("I2:I105").Copy
Worksheets("Daten Umschläge").Range("C2").PasteSpecial xlPasteValues
'Kopieren der Daten für BB
Worksheets("Auswahllisten").Range("G2:G105").Copy
Worksheets("Daten BB").Range("A2").PasteSpecial xlPasteValues
Worksheets("Eingabetabelle").Range("D2:D105").Copy
Worksheets("Daten BB").Range("B2").PasteSpecial xlPasteValues
Worksheets("Auswahllisten").Range("H2:H105").Copy
Worksheets("Daten BB").Range("C2").PasteSpecial xlPasteValues
'Duplikate entfernen
Worksheets("Daten Umschläge").Range("$A$1:$G$105").RemoveDuplicates Columns:=1, Header:= _
xlYes
2.
Option Explicit
Private MYPATH As String
Sub MacroMitDeinemFormularSteuerelementVerknuepfen()
Dim sText As String
MYPATH = Environ("temp")
sText = "Sehr geehrte Damen und Herren,
sText = sText & "anbei die Daten .
"
sText = sText & "
"""
Call SendSheetOutlook( _
"Betreffzeile", _
"Mailadresse", _
"", _
sText)
End Sub
Private Sub SendSheetOutlook(sSubject As String, sTo As String, sCC As String, ByVal sText As _
String)
Dim olApp As Object
Dim AWS As String
Dim olOldBody As String
'define temporary Path and Filename
AWS = MYPATH & "\" & Format(Date, "YYYYMMDD") & "_" & Format(Time, "hhmmss") & "_" & _
WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xlsm", "")
'export File as PDF
Worksheets(4).ExportAsFixedFormat Type:=xlTypePDF, Filename:=AWS, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
AWS = AWS & ".pdf"
'Make Email
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.GetInspector.Display
olOldBody = .htmlBody
.To = sTo
.cc = sCC
.Subject = sSubject
.htmlBody = sText & olOldBody
.Attachments.Add AWS
End With
'remove TEMP file
'wenn du das PDF behalten möchtest, diese Zeile auskommentieren!
'sonst wird das temporäre PDF wieder gelöscht
'Kill AWS
3.
'Datei Speichern und beenden
'ActiveWorkbook.SaveCopyAs "C:\Dateipfad\liste_" & Format(Now, "dd.mm.yyyy") & ".xlsm"
'ThisWorkbook.Saved = True
'Application.Quit
End Sub
Die Nummerierung soll die Neuordnung darstellen und ist natürlich nicht im Originalcode vorhanden.verzweifelten Dank schon mal vorab.