Impression/PDF/mail

Shell "Outlook.exe"

Set objwShell = CreateObject("wscript.shell")

    Dim OlApp As Outlook.Application
    Dim OlItem As Outlook.MailItem
    
    Set OlApp = New Outlook.Application
    Set OlItem = OlApp.CreateItem(olMailItem)
    
    With OlItem
        .To = adresse@machin.truc
        .Subject = "Objet du mail"
        .Body = "Corps du message"
        .Attachments.Add ActiveWorkbook.FullName
        .Display
        .Send
    End With
    
    Set OlItem = Nothing
    Set OlApp = Nothing

Application.ScreenUpdating = False
Application.ShowWindowsInTaskbar = False
Application.DisplayAlerts = False

Dim objPDF As Object
Dim S As Worksheet
Dim R As Range
Dim OBJ As Object
Dim rep&
Dim ImprimanteActive$
Dim Message$

ImprimanteActive$ = Application.ActivePrinter

[B]Range("A1:G62").Select[/B]

Set R = Selection
Set objPDF = CreateObject("PDFCreator.clsPDFCreator")
With objPDF
  If .cStart("/NoProcessingAtStartup") = False Then
    MsgBox prompt:="On ne peut pas lancer PDFCreator", _
        Buttons:=vbInformation + vbOKOnly
    Exit Sub
  End If
  .cOption("UseAutosave") = 1
  .cOption("UseAutosaveDirectory") = 1
  .cOption("AutosaveDirectory") = "Nom du répertoire complet"
  .cOption("AutosaveFilename") = "Nomdufichier.pdf"
  .cOption("AutosaveFormat") = 0
  .cClearCache
End With
If TypeName(Selection) = "Range" Then
  R.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Else
  S.PrintOut copies:=1, ActivePrinter:="PDFCreator"
  Application.DisplayAlerts = False
  S.Delete
  Set S = Nothing
  Application.DisplayAlerts = True
End If
Do Until objPDF.cCountOfPrintjobs = 1
  DoEvents
Loop
objPDF.cPrinterStop = False
Do Until objPDF.cCountOfPrintjobs = 0
  DoEvents
Loop
With objPDF
  .cDefaultPrinter = "PDFCreator"
  .cClearCache
  .cClose
End With
Set objPDF = Nothing

Application.ActivePrinter = ImprimanteActive$
Application.ScreenUpdating = True
Application.ShowWindowsInTaskbar = True
Application.DisplayAlerts = True

Sub mail()

'envoi n°1
Nord = "C:\Documents and Settings\Compta\fichier1.pdf"
Dest1 = "toto@orange.fr"

Sujet = "Suivi"
Msg = " Bonjour, " & vbCrLf & vbCrLf
Msg = Msg & "Veuillez trouver ci-joint un état du suivi."
Msg = Msg & vbCrLf & vbCrLf & " SB "

Shell "C:\Program Files\Outlook Express\msimn.exe " & _
"/mailurl:mailto:" & Dest1 & "?subject=" & Sujet & "&Body=" & Msg & ""
SendKeys "%I" & "p" & Nord & "~" & "%s"


'envoi n°2
Laur = "C:\Documents and Settings\Compta\fichier2.pdf"
dest2 = "titi@orange.fr"

Sujet = "Suivi "
Msg = " Bonjour, " & vbCrLf & vbCrLf
Msg = Msg & "Veuillez trouver ci-joint un état du suivi."
Msg = Msg & vbCrLf & vbCrLf & " SB "
Shell "C:\Program Files\Outlook Express\msimn.exe " & _
"/mailurl:mailto:" & dest2 & "?cc=" & copie & "&subject=" & Sujet & "&Body=" & Msg & ""
SendKeys "%I" & "p" & Laur & "~" & "%s"

End sub

Private Sub CommandButton1_Click()
Call mail1
End Sub

Private Sub CommandButton2_Click()
Call mail2
End Sub

Private Sub CommandButton3_Click()
Call mail3
End Sub

Private Sub CommandButton1_Click()
Call mail1
Call mail2
Call mail3
End Sub