Hi guys,
it's my first try in this community and hope someone can help me with my vba issue. I already modified a vba code I found in the internet. This code already send the document in .xlsm and save it into the correct folder.
My question, is it possible to modify it in the way that the file still will be saved as .xlsm and send a copy as a .xls? Does not make sense to send the file with all macro buttons working to my colleagues :-D Otherwise they would click the buttons and I will get many new emails
Thanks in advance
The code:
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
Bookmarks