Bonjour le forum,
J'utiliser le code ci-dessous afin d'envoyer un fichier excel (xlsm) dans outlook directement aux personnes qui se trouve en cellule E36 et E35. Cela fonctionnne très bien, mais le fichier que reçois les personnes n'est pas complet. Ils manquent les modules VBE ils n'ont pas été copiés.
Comment puis-je copier les modules avec le fichier xlsm que j'envoie.
Merci de votre aide.
Soleil11😎
J'utiliser le code ci-dessous afin d'envoyer un fichier excel (xlsm) dans outlook directement aux personnes qui se trouve en cellule E36 et E35. Cela fonctionnne très bien, mais le fichier que reçois les personnes n'est pas complet. Ils manquent les modules VBE ils n'ont pas été copiés.
Comment puis-je copier les modules avec le fichier xlsm que j'envoie.
Code:
Sub EmailActiveSheetWithOutlook()
Dim TransfCop
Dim BTnr
Dim oApp, oMail As Object, _
tWB, cWB As Workbook, _
FileName, FilePath As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Application.ScreenUpdating = False
TransfCop = Sheets("Form").Range("E36")
TransfOwn = Sheets("Form").Range("E35")
BTnr = Sheets("Form").Range("D3")
Set cWB = ActiveWorkbook
'Set email id here, it may be a range in case you have email id on your worksheet
Mailid = TransfCop
Mailcc = TransfOwn
'Write your email message body here , add more lines using & vbLf _ at the end of each line
Body = "Please find enclosed Budget Transfer Form accepted by Owner" & vbLf _
& vbLf _
& "Thanks & Regards"
'Copy Active Sheet and save it to a temporary file
Set cWB = ActiveWorkbook
'ActiveSheet.Copy (only active sheet)
With cWB
.Worksheets.Copy
End With
Set tWB = ActiveWorkbook
FileName = BTnr & " " & "Budget Transfer" 'You can define the name
FilePath = Environ$("TEMP")
On Error Resume Next
Kill FilePath & "\" & FileName
On Error GoTo 0
Application.DisplayAlerts = False
tWB.SaveAs FileName:=FilePath & "\" & FileName, FileFormat:=52
Application.DisplayAlerts = True
'Sending email through outlook
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = Mailid
.CC = Mailcc
.Subject = "Budget Transfer" & " " & BTnr & "=>" & "Owner has been Accepted"
.Body = Body
.Attachments.Add tWB.FullName
.Send
End With
'Delete the temporary file and restore screen updating
tWB.ChangeFileAccess Mode:=xlReadOnly
Kill tWB.FullName
tWB.Close SaveChanges:=False
cWB.Activate
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub
Merci de votre aide.
Soleil11😎