Bonjour,
J'ai un programme qui m'envoie un fichier xls par mail.
Je souhaiterais l'avoir en .pdf à la place. J'utlise acrobat reader 7.0
Comment convertir mon programme ci-dessous:
Sub Mail_Every_Worksheet()
'Working in 2000-2007
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
TempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsm": FileFormatNum = 52
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set wb = ThisWorkbook
For Each sh In ThisWorkbook.Worksheets
If sh.Visible = True Then
'Recopie dans le nouveau classeur les autres feuilles
If wb.Name <> ThisWorkbook.Name Then ThisWorkbook.Sheets(sh.Name).Copy After:=wb.Sheets(wb.Sheets.Count)
If wb.Name = ThisWorkbook.Name Then
ThisWorkbook.Sheets(sh.Name).Copy
Set wb = ActiveWorkbook
End If
End If
Next sh
TempFileName = "Etude " & wb.Sheets("Result").Customer.Value & " " & Format(Now, "dd-mmm-yy")
Set OutMail = OutApp.CreateItem(0)
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
strbody = "Bonjour," & vbNewLine & vbNewLine & _
"Veuillez trouvez ci-joint l'étude pour cette campagne." & vbNewLine & _
"" & vbNewLine & _
"Amic'"
SigString = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signatures\Cédric.txt"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.To = Sheets("Result").Range("V1").Value
.CC = ""
.BCC = ""
.Subject = Sheets("Result").Range("V2").Value
.Body = strbody & vbNewLine & vbNewLine & Signature
.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Set OutMail = Nothing
Kill TempFilePath & TempFileName & FileExtStr
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Merci
J'ai un programme qui m'envoie un fichier xls par mail.
Je souhaiterais l'avoir en .pdf à la place. J'utlise acrobat reader 7.0
Comment convertir mon programme ci-dessous:
Sub Mail_Every_Worksheet()
'Working in 2000-2007
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
TempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsm": FileFormatNum = 52
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set wb = ThisWorkbook
For Each sh In ThisWorkbook.Worksheets
If sh.Visible = True Then
'Recopie dans le nouveau classeur les autres feuilles
If wb.Name <> ThisWorkbook.Name Then ThisWorkbook.Sheets(sh.Name).Copy After:=wb.Sheets(wb.Sheets.Count)
If wb.Name = ThisWorkbook.Name Then
ThisWorkbook.Sheets(sh.Name).Copy
Set wb = ActiveWorkbook
End If
End If
Next sh
TempFileName = "Etude " & wb.Sheets("Result").Customer.Value & " " & Format(Now, "dd-mmm-yy")
Set OutMail = OutApp.CreateItem(0)
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
strbody = "Bonjour," & vbNewLine & vbNewLine & _
"Veuillez trouvez ci-joint l'étude pour cette campagne." & vbNewLine & _
"" & vbNewLine & _
"Amic'"
SigString = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signatures\Cédric.txt"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.To = Sheets("Result").Range("V1").Value
.CC = ""
.BCC = ""
.Subject = Sheets("Result").Range("V2").Value
.Body = strbody & vbNewLine & vbNewLine & Signature
.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Set OutMail = Nothing
Kill TempFilePath & TempFileName & FileExtStr
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Merci