XL 2010 VBA-Imprime mail outlook en pdf

Bens7

XLDnaute Impliqué
Bonjour a tous !
Voila j'ai unpetit sub avec le quel je trvail depuis longtemp :

VB:
Sub pdf()
   'SAUVEGARDE PDF
   On Error Resume Next
ActiveSheet.ExportAsFixedFormat xlTypePDF, "D:\MONDOSSIER\FACTURE\" & [R60] & ".pdf"
ActiveWorkbook.Close SaveChanges:=True
End Sub
Voila en fait j'aimerais imprimer de la meme maniere un email recu dans Outlook 2010 present dans :
- Le account 1
- Boite de reception
- L'adresse email a trouver est dans ma sheets en [AE63]
- Dans : "D:\MONDOSSIER\MAIL\" & [R60] & ".pdf"

P.S : Alors Google est mon ami ... je sais ... mais introuvable
P.S2 : Alors novice de chez novice ( juste adaptation de code au besoin mais je voie pas du tout comment faire ca ....)

Merci !!
 

job75

XLDnaute Barbatruc
Bonjour Bens7,
- L'adresse email a trouver est dans ma sheets en [AE63]
Si en AE63 on a bien un lien hypertexte utilisez-le pour ouvrir le fichier :
Code:
Sub email_pdf()
With ActiveSheet
    ThisWorkbook.FollowHyperlink .[AE63].Hyperlinks(1).Address
    ActiveSheet.ExportAsFixedFormat xlTypePDF, "D:\MONDOSSIER\MAIL\" & .[R60]
End With
ActiveWorkbook.Close False
End Sub
A+
 

Bens7

XLDnaute Impliqué
Non je crois que je me suis mal exprimer (ci joint un fichier)
1) On cherche le mail reçu dans ma boite de réception (Acount 1) de la part de monsieurtext@gmail.com
2) On imprime cet email en pdf > dans le dossier "D:\MONDOSSIER\MAIL\" & .[R63]

Le code si dessus c'est juste pour dire ...voila je sais sauvegarder un fichier excel en pdf... mais pour un mail alors la ... aucune idée... donc du coup a chaque mail je vais dans Outlook, sélectionne mon mail, Créer un fichier en pdf, va dans le dossier et sauvegarder ... c'est exactement ça que je veux faire via macro automatique.
 

Fichiers joints

Dernière édition:

Bens7

XLDnaute Impliqué
Alors je suis fier de moi ! Après 1 bonne heure de recherche j'ai trouver un macro qui fonctionne et qui vous mettra surement sur la piste de ce que j'ai besoin mais qui n'est pas encore ce que je souhaite et qui présente plusieurs problème :
1) Le code VBA est a mettre dans outlook j'en est besoin absolument depuis Excel pour le lancer via le bouton de mon fichier non via l'executeur de macro Outlook.
1 bis) Impossible également de définir le numéro de l'account voulu
2) Et donc ça marche juste quand on sélectionne le mail voulu non en le trouvant depuis mon fichier excel.[AE63]
3) Du coup impossible aussi de definir le nom du pdf :
msgFileName = Workbooks("Classeur1.xlsm").Sheets("Feuil1").[R63]
j'ai temporairement mis le nom 18432 pour les essais​
4) Je ne veux pas de la fenêtre de destination et enregistrer, que cela s'enregistre tout seul
5) J'ai vu qu'on fait appel a Word... mais je suis vraiment novice j’espère que ce code vous mettra sur la piste et surtout n’hésitez pas a l’épurer ... comprend rien!

VB:
Sub SaveAsPDFfile()
Dim MyOlNamespace As NameSpace
Dim MySelectedItem As MailItem
Dim Response As String
Dim FSO As Object, TmpFolder As Object
Dim tmpFileName As String
Dim wrdApp As Object
Dim wrdDoc As Object
Dim bStarted As Boolean
Dim dlgSaveAs As FileDialog
Dim fdfs As FileDialogFilters
Dim fdf As FileDialogFilter
Dim i As Integer
Dim WshShell As Object
Dim SpecialPath As String
Dim msgFileName As String
Dim strCurrentFile As String
Dim strName As String
Dim oRegEx As Object
Dim intPos As Long

    Set MyOlNamespace = Application.GetNamespace("MAPI")

    'Make sure at least one item is selected

    'Retrieve the selected item
    Set MySelectedItem = ActiveExplorer.Selection.Item(1)

    'Get the user's TempFolder to store the item in

    Set FSO = CreateObject("Scripting.FileSystemObject")
    tmpFileName = FSO.GetSpecialFolder(2)
    'construct the filename for the temp mht-file
    strName = "email_temp.mht"
    tmpFileName = tmpFileName & "\" & strName

    'Save the mht-file
    MySelectedItem.SaveAs tmpFileName, 10

    'Create a Word object
    On Error Resume Next
    Set wrdApp = GetObject(, "Word.Application")
    If Err Then
        Set wrdApp = CreateObject("Word.Application")
        bStarted = True
    End If
    On Error GoTo 0

    'Open the mht-file in Word without Word visible
    Set wrdDoc = wrdApp.Documents.Open(FileName:=tmpFileName, Visible:=False, Format:=7)
    'Define the SafeAs dialog
    Set dlgSaveAs = wrdApp.FileDialog(msoFileDialogSaveAs)

    'Determine the FilterIndex for saving as a pdf-file
    'Get all the filters
    Set fdfs = dlgSaveAs.Filters

    'Loop through the Filters and exit when "pdf" is found
    i = 0
    For Each fdf In fdfs
        i = i + 1
        If InStr(1, fdf.Extensions, "pdf", vbTextCompare) > 0 Then
            Exit For
        End If
    Next fdf

    'Set the FilterIndex to pdf-files
    dlgSaveAs.FilterIndex = i

    'Get location of My Documents folder

    Set WshShell = CreateObject("WScript.Shell")
    SpecialPath = "D:\MON DOSSIER\EMAIL"
    'Construct a safe file name from the message subject
    msgFileName = 18432
    'marche pas:
    'msgFileName = Workbooks("Classeur1.xlsm").Sheets("Feuil1").[a6]

    Set oRegEx = CreateObject("vbscript.regexp")
    oRegEx.Global = True
    oRegEx.Pattern = "[\/:*?""<>|]"
    msgFileName = Trim(oRegEx.Replace(msgFileName, ""))

    'Set the initial location and file name for SaveAs dialog
    dlgSaveAs.InitialFileName = SpecialPath & "\" & msgFileName

    'Show the SaveAs dialog and save the message as pdf
    If dlgSaveAs.Show = -1 Then
        strCurrentFile = dlgSaveAs.SelectedItems(1)

        'Verify if pdf is selected
        If Right(strCurrentFile, 4) <> ".pdf" Then
            Response = MsgBox("Sorry, only saving in the pdf-format is supported." & _
                              vbNewLine & vbNewLine & "Save as pdf instead?", vbInformation + vbOKCancel)
            If Response = vbCancel Then
                wrdDoc.Close 0
                If bStarted Then wrdApp.Quit
                Exit Sub
            ElseIf Response = vbOK Then
                intPos = InStrRev(strCurrentFile, ".")
                If intPos > 0 Then
                    strCurrentFile = Left(strCurrentFile, intPos - 1)
                End If

                strCurrentFile = strCurrentFile & ".pdf"
            End If
        End If

        'Save as pdf
        wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                                                  strCurrentFile, _
                                                  ExportFormat:=17, _
                                                  OpenAfterExport:=False, _
                                                  OptimizeFor:=0, _
                                                  Range:=0, _
                                                  From:=0, _
                                                  To:=0, _
                                                  Item:=0, _
                                                  IncludeDocProps:=True, _
                                                  KeepIRM:=True, _
                                                  CreateBookmarks:=0, _
                                                  DocStructureTags:=True, _
                                                  BitmapMissingFonts:=True, _
                                                  UseISO19005_1:=False
    End If
    Set dlgSaveAs = Nothing

    ' close the document and Word
    wrdDoc.Close
    If bStarted Then wrdApp.Quit

    'Cleanup
    Set MyOlNamespace = Nothing
    Set MySelectedItem = Nothing
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
    Set oRegEx = Nothing

End Sub
 
Dernière édition:

Alain jetté

XLDnaute Nouveau
Déjà, tu peux récupérer le nom du fichier en passant par l'ajout d'une variable string. Ce sera un pas de plus vers ton résultat désiré:

Ajouter la variable suivante au début:

Dim NomItem As String

À la suite de la récupération de l'item courriel, tu assignes le nom du courriel à la variable string ici:

'Retrieve the selected item
Set MySelectedItem = ActiveExplorer.Selection.Item(1)
NomItem = MySelectedItem.Subject


Puis, au lieu de lui donner un chiffre comme nom, on lui assigne le nom de l'item ici:
'Construct a safe file name from the message subject
msgFileName = NomItem


(au lieu de 18432)
 

Discussions similaires


Haut Bas