Fonction ouvrir une boite de dialogue dans un donssier précis

[Fredox]

Bonjour,

Via mon tableau pour du mailing avec pieces jointes, j'aimerais sélectionné une signature via une boite de dialogue. Comment passer d'une signature dont le chemin est écrit en code (comme ci-dessous)

SigString = Environ("appdata") & _
   "\Microsoft\Signatures\Signature.htm"

A une signature sélectionnée via une boite de dialogue (mais que le répertoire cible soit ouvert à l'avance au bon endroit ?

    SigString = Application.GetOpenFilename(, , "Sélectionnz une signature mail")

vers: Environ("appdata") & _
"\Microsoft\Signatures\

Merci

 

[Hasco]

Bonjour,

Voici une fonction qui utilise Application.FileDialog de préférence à GetOpenFilename pour laquelle il faut changer le répertoire et/ou disque courant pour ouvrir la fenêtre de choix au bon endroit

Function getSignature() As String
    Dim fdlg As FileDialog
    Set fdlg = Application.FileDialog(msoFileDialogFilePicker)
    With fdlg
        .Filters.Add "fichier signature", "*.htm ; *.html", 1
        .InitialFileName = Environ("appdata") & "\Microsoft\Signatures\signature.htm"
        .AllowMultiSelect = False
        .Title = "Sélectionnez un fichier signature"
        If .Show = -1 Then getSignature = .SelectedItems(1)
    End With
    Set fdlg = Nothing
End Function

Cordialement

 

[Fredox]

Roblochon,

Merci d'avoir regarder.
Je l'ai intégré a ma macro, au lancement elle plante en indiquant "Erreur de compilation, End Sub attendu"

Une idée ?
Merci

 

[Hasco]

Re,

Il ne faut pas l'intégré dans une macro mais en dehors dans le même module que votre macro suivant le modèle ci-dessous, ou un autre module.

Il est grand temps que vous suiviez un tutoriel de base sur les procédures (qui exécutent des actions) et fonctions (qui en plus renvoient une valeur).

Je n'ai pas ouvert votre fichier, je vous laisse faire.

Sub VotreMacroEnvoiMails()

Dim FichierSignature as String

'......
FichierSignature = getSignature()

'....... 
'.......

End Sub



Function getSignature()

'..... contenu de la fonction

End Fuction

Cordialement

 

[Fredox]

😱

 

[Fredox]

Roblochon,

J'ai fais comme tu le dis, mais cela entraine une erreur sur une autre fonction, avant cela fonctionnait.
Tu saurais pourquoi ?

ici

Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)

Merci

 

[Hasco]

Re,

En fait vous ne savez pas du tout ce que votre macro fait !!!!!
Apparemment vous ne savez pas quels rôles jouent vos variables.

Il est temps de suivre un tuto VBA de base.

De plus dans votre dernier fil, il me semble vous avoir déjà dit que les déclarations de variables se font en tête de macro.

Ce sera donc ma dernière intervention sur ce fil puisque j'ai répondu largement à la question initiale.

Examinez ce qui a changé ici :

Sub Mail()

    'Working in Excel 2000-2016
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

    Dim TempFilePath As String, Strbody As String, TempFileName As String
    Dim FileExtStr As String, FichierSignature As String, Signature As String
    Dim FileFormatNum As Long, DL As Long, DLt As Long, j As Long
    Dim Sourcewb As Workbook, destwb As Workbook
    Dim OutApp As Object, OutMail As Object
    Dim sFichier1 As String, sFichier2 As String, sFichier3 As String
    
    sFichier1 = Worksheets("Mail").Range("C4")
    sFichier2 = Worksheets("Mail").Range("C5")
    sFichier3 = Worksheets("Mail").Range("C6")


    If Worksheets("Liste").Range("D3") = "" Then
        Prbemail
        Exit Sub
    End If

    Application.DisplayAlerts = False

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    '---

    Strbody = "Bonjour " & Prenom & ",<br>" _
            & "<br>" _
            & "Cordialement,<br>" _
            & "<br>" _
            & "<br>"


'--------------------------------------------------------------------------------------------------

    FichierSignature = getSignature()
'--------------------------------------------------------------------------------------------------


    If Dir(FichierSignature) <> "" Then Signature = GetBoiler(FichierSignature)

    '---
    DL = Worksheets("Liste").Cells(Rows.Count, 4).End(xlUp).Row
    DLt = Worksheets("Mail").Cells(Rows.Count, 3).End(xlUp).Row

    '
    '---- Construction du corps de mail dans lequel 'Texte0' sera inséré plus tard
    '
    Strbody = "<font style='font-family: Arial ;font-size: 10pt ;font-style: Regular; '>[Texte0]<br>"

    For j = 10 To DLt
        Strbody = Strbody & Worksheets("Mail").Range("C" & j) & "<br>"
    Next

    Strbody = Strbody & "<br>" & Signature
    '
    '--- Initialisation de l'objet Outlook Application
    '
    Set OutApp = CreateObject("Outlook.Application")
    '
    '--- Construction des mails et envois
    '
    For i = 3 To DL
        '
        ' Insertion des parties variable du corps de mail
        '
        If Worksheets("Liste").Range("B" & i) <> "" Then
            Texte0 = "Bonjour " & Worksheets("Liste").Range("A" & i) & " " & Worksheets("Liste").Range("B" & i) & "," & "<br>"
        Else
            Texte0 = "Bonjour " & Worksheets("Liste").Range("C" & i) & ","
        End If
        
        Strbody = Replace(Strbody, "[Texte0]", Texte0)
        '
        ' Création d'un nouveau mail item
        '
        Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .To = Worksheets("Liste").Range("D" & i)
            .Cc = ""
            .BCC = ""
            .Subject = Worksheets("Mail").Range("C2")
            .HTMLBody = Strbody
            If sFichier1 <> "" Then .Attachments.Add sFichier1
            If sFichier2 <> "" Then .Attachments.Add sFichier2
            If sFichier3 <> "" Then .Attachments.Add sFichier3
            .display
        End With
        '
        ' nettoyage de la variable objet mail courant
        Set OutMail = Nothing
        '.Close savechanges:=False

    Next
    '
    '--- Nettoyage des variable objet outlook
    '
    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

    Application.DisplayAlerts = True

End Sub

bonne continuation

 

[Fredox]

Roblochon,

Effectivement, la lecture du poste laissait la fonction après la macro, je n'avais pas lu.
J'ai repris selon tes recommandations, cela fonctionne donc, sauf que si j'annule la fenêtre du choix de signature, ca se met en erreur ici

Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)

Y'a t'il moyen de défaire cette erreur ?


Je comprends je cela de fatigue, mais j'ai déja pas mal progresser mais je ne maitrise pas forcement les bases, c'est sûr. Je vais voir les tutos, je ne les avaient jamais parcourus. Il faut juste que je trouve le temps de prendre le temps.

Merci