Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1520to1524
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - Excelsheet versenden (Speicherung)

VBA - Excelsheet versenden (Speicherung)
09.11.2016 15:47:25
Alex
Hi,
ich bin im Internet fündig geworden um mein bestehendes Excelsheet zu versenden. Leider bin ich kein VBA Profi und habe da noch ein kleines Problem. Ich hoffe mir kann dabei einer helfen.
Momentan ist es so das die Datei als .xlsm verschickt wird. Mir wäre es am liebsten wenn er die Quelldatei als .xlsm speichert und eine Kopie als .xls verschickt - sprich das bei meiner Email die Makros deaktiviert sind. Ist dies möglich und kann mir einer dabei helfen? Vielen Dank im voraus :-)
Der Code sieht bisher so aus:
Sub Mail_Workbook()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb1 = ActiveWorkbook
'Make a copy of the file/Open it/Edit it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = "Pfad zum Zielordner"
TempFileName = "filename " & Format(Now() - 1, "dd-mmm-yy")
'Configure yesterday
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
'**************Add code to edit the file here********************
'Insert a text and Date in cell A1 of the first sheet in the workbook.
'Other things you can think of are for example, delete a whole sheet or a range.
wb2.Worksheets(1).Range("A1").Value = "Copy created on " & Format(Date, "dd-mmm-yyyy")
'Save the file after we changed it with the code above
wb2.Save
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = ThisWorkbook.Sheets("QUELLEVERSAND").Range("O1").Value
.CC = ""
.BCC = ""
.Subject = "TEXT - " & Format(Now() - 1, "dd-mmm-yy")
.Body = "Dear colleagues," & vbCrLf & "pls find attached our latest ..." & vbCrLf & " _
Feel free to contact me if there are any questions." & vbCrLf & "Kindly regards" & vbCrLf & "ME"
.Attachments.Add wb2.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send   'or use .Display
End With
On Error GoTo 0
wb2.Close savechanges:=False
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Excelsheet versenden (Speicherung)
10.11.2016 05:00:03
fcs
Hallo Alex,
um die an die E-Mail angehängte Datei Makro-Frei zu bekommen kopierst du die relevanten Blätter der Datei in eine neue Mappe.
Diese neue Mappe speicherst du dann im xlsx-Format (also ohne Makros)
Sind unter den Blättern keine Makros gespeichert, dann könntest du die Datei auch im älteren xls-Format speichern.
Anschliesend kannst du diese Datei schliessen und als E-Mail-Anhang versenden.
LG
Franz
AW: VBA - Excelsheet versenden (Speicherung)
10.11.2016 09:29:22
Alex
Hallo Franz,
dass ist nett gemeint, aber dann macht es für mich wenig Sinn überhaupt Makros zu verwenden wenn ich die dann sowieso alles per Hand mache inkl. des verschicken. Letztendlich speichert das von mir gepostete Makro auch die Datei - nur allerdings in .xlsm.
Gruß
Alex
Anzeige
AW: VBA - Excelsheet versenden (Speicherung)
10.11.2016 21:43:45
fcs
Hallo Alex,
mein Vorschlag war als eine mögliche Lösung gemeint, die man dann natürlich in dem vorhandenen Makro einbauen muss.
Das kann dann wie folgt aussehen.
Gruß
Franz
Sub Mail_Workbook()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb1 = ActiveWorkbook
'#### relevanter Zeilenbereich  - Start   ####
Application.Calculate
'Copy sheets of the file in New Workbook /Edit it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = wb1.Path & Application.PathSeparator & "Archiv" & Application.PathSeparator   _
'ggf. anpassen!
TempFileName = Left(wb1.Name, InStrRev(wb1.Name, ".") - 1) & " "      'ggf. anpassen!
'Configure yesterday
TempFileName = TempFileName & Format(Now() - 1, "dd-mmm-yy") '"YYYY-MM-DD"
FileExtStr = "." & "xlsx"
'Alle Blätter in neue Mappe kopieren
wb1.Sheets.Copy       'alle Blätter                           ggf. anpassen!
'      wb1.Sheets(Array(1, 2)).Copy  'Blatt-Auswahl kopieren      ggf. anpassen!
Set wb2 = ActiveWorkbook
Application.DisplayAlerts = False 'vorhandener Name wird gf. überschrieben
wb2.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=51 'ohne Makros speichern
Application.DisplayAlerts = True
'#### relevanter Zeilenbereich  - Ende   ####
'**************Add code to edit the file here********************
'Insert a text and Date in cell A1 of the first sheet in the workbook.
'Other things you can think of are for example, delete a whole sheet or a range.
wb2.Worksheets(1).Range("A1").Value = "Copy created on " & Format(Date, "dd-mmm-yyyy")
'Save the file after we changed it with the code above
wb2.Save
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = ThisWorkbook.Sheets("QUELLEVERSAND").Range("O1").Value
.CC = ""
.BCC = ""
.Subject = "TEXT - " & Format(Now() - 1, "dd-mmm-yy")
.Body = "Dear colleagues," & vbCrLf & "pleass find attached our latest ..." & vbCrLf &  _
_
"Feel free to contact me if there are any questions." & vbCrLf _
& "Kindly regards" & vbCrLf & "ME"
.Attachments.Add wb2.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send   'or use .Display
End With
On Error GoTo 0
wb2.Close savechanges:=False
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Anzeige
AW: VBA - Excelsheet versenden (Speicherung)
11.11.2016 13:59:04
Alex
Hallo Franz,
damit kann ich was anfangen :-)
Vielen Dank!
LG
Alex

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige