CODE VBA : demande de relevés compteurs d'imprimantes par mail

Bonjour à toutes et à tous,

Je sollicite votre aide car j'ai un tableau Excel dans lequel je saisis des relevés compteurs d'imprimantes tous les trimestres et certains clients oublient de me communiquer leur relevés, la cellule est donc vide et je dois envoyer un mail a chaque client pour le réclamer ce qui est fastidieux.

C'est pourquoi je cherche le code pour automatiser cette tache et ainsi envoyer un mail type comportant le même objet et le même contenu à chaque client ne m'ayant pas communiqué ses relevés.

Par ailleurs et afin d'en assurer le suivi , je souhaiterais que la date de l'envoi soit indiqué dans une cellule Date d'envoi.

Je vous joins en exemple un tableau.

Merci

Stéphane

Bonjour Stéphane,

puisque l'objet et le contenu du mail sont toujours les mêmes tu peux supprimer les colonnes D et E dans ton fichier. Voici un exemple à tester

Sub test()
'https://forum.excel-pratique.com/excel/code-vba-demande-de-releves-compteurs-d-imprimantes-par-mail-181158

Dim OutApp As Object, OutMail As Object
Dim cel As Range
Dim DerLig As Integer

DerLig = Cells(Rows.Count, 1).End(xlUp).Row

Set OutApp = CreateObject("Outlook.Application")

For Each cel In Range("C2:C" & DerLig)

    If IsEmpty(cel) Then
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next

        With OutMail
            .to = cel.Offset(0, -1).Value
            .Subject = "Demande de relevés compteurs"
            .Body = "Bonjour, je vous remercie de Me communiquer les relevés compteurs de votre imprimante"
            .Display        'ou .Send
            ' .Send
        End With
        cel.Offset(0, 1).Value = Date

    End If   
Next cel
On Error GoTo 0

End Sub

Cordialement

Bonjour Sequoyah,

Merci beaucoup pour ton retour car le code fonctionne :)

Par contre j'utilise le client de messagerie Gmail, sais tu comment le coupler avec Excel car il ne figure pas dans liste des références ?

Cdt

Stéphane

Bonjour Stéphane,

pour utiliser Gmail, tu dois d'abord

1. Accéder à ton compte Google

2. Activer la validation en deux étapes, voir ce lien pour en savoir plus https://support.google.com/accounts/answer/185839?hl=fr&ref_topic=7189195

3. Créer et utiliser des mots de passe d'application - code secret à 16 chiffres https://support.google.com/accounts/answer/185833?hl=fr

Voici le code, à adapter l'adresse e-mail et le mot de passe

Sub SendEmailUsingGmail()
'https://forum.excel-pratique.com/excel/code-vba-demande-de-releves-compteurs-d-imprimantes-par-mail-181158

    Dim NewMail As Object
    Dim mailConfig As Object
    Dim fields As Variant
    Dim msConfigURL As String
    Dim cel As Range
    Dim DerLig As Integer

DerLig = Cells(Rows.Count, 1).End(xlUp).Row

    On Error GoTo Err:

For Each cel In Range("C2:C" & DerLig)

    If IsEmpty(cel) Then
    'late binding
    Set NewMail = CreateObject("CDO.Message")
    Set mailConfig = CreateObject("CDO.Configuration")

    ' charger toutes les configurations par défaut
    mailConfig.Load -1

    Set fields = mailConfig.fields

    'Définir toutes les propriétés de messagerie
    With NewMail
        .From = "xxx@gmail.com" '<=== A' adapter
        .To = cel.Offset(0, -1).Value
         .Subject = "Demande de relevés compteurs"
        .Textbody = "Bonjour, je vous remercie de me communiquer les relevés compteurs de votre imprimante"
    End With

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    With fields
        .Item(msConfigURL & "/smtpusessl") = True             'Enable SSL Authentication
        .Item(msConfigURL & "/smtpauthenticate") = 1          'SMTP authentication Enabled
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
        .Item(msConfigURL & "/smtpserverport") = 465          'Set the SMTP port Details
        .Item(msConfigURL & "/sendusing") = 2                 'Send using default setting
        .Item(msConfigURL & "/sendusername") = "xxx@gmail.com" 'Your gmail address '<=== A' adapter
        .Item(msConfigURL & "/sendpassword") = "xxxxxxxxxxxxxxxx" 'Your App Password '<=== A' adapter
        .Update                                               'Update the configuration fields
    End With
    NewMail.Configuration = mailConfig
    NewMail.Send

 cel.Offset(0, 1).Value = Date

End If

Next cel

Exit_Err:
    'Release object memory
    Set NewMail = Nothing
    Set mailConfig = Nothing
    End

Err:
    Select Case Err.Number
    Case -2147220973  'Peut-être à cause de la connexion Internet
        MsgBox "Vérifiez votre connection internet." & vbNewLine & Err.Number & ": " & Err.Description
    Case -2147220975  'Informations d'identification incorrectes ID utilisateur ou mot de passe
        MsgBox "Vérifiez vos identifiants de connexion et réessayez." & vbNewLine & Err.Number & ": " & Err.Description
    Case Else   'Signaler d'autres erreurs
        MsgBox "Erreur rencontrée lors de l'envoi de l'e-mail." & vbNewLine & Err.Number & ": " & Err.Description
    End Select

    Resume Exit_Err

End Sub

Bonjour Sequoyah,

Je te remercie beaucoup pour ton accompagnement c'est parfait, je vais gagner un temps fou !

A très bientôt, Stéphane.

Bonjour Sequoyah,

Je sollicite à nouveau ton expertise car je rencontre un autre problème.

Je dispose de 2 classeurs, voir PJ, que j'ai simplifié pour l'exemple :

le A pour la facturation comportant les copieurs avec leur matricule respectifs ainsi que les cellules vides des 3 compteurs à renseigner (405/410/409) et le classeur B comportant les mêmes matricules que A mais avec les données de compteurs (405/410/409).

Ma question est de savoir comment depuis A je peux importer les données des cellules compteurs du classeur B en faisant matcher les matricules identiques

et ainsi remplir automatiquement les 3 cellules compteurs du classeur A.

Voilà, je te remercie de ton aide précieuse.

Stéphane

Bonjour Stéphane,

il serait préférable d'ouvrir un nouveau fil car il s'agit d’un sujet différent. Voici le code (à adapter le chemin et le nom de ton fichier csv)

Sub testCSV()
'https://forum.excel-pratique.com/excel/code-vba-demande-de-releves-compteurs-d-imprimantes-par-mail-181158

Dim CsvWb As Workbook
Dim MonCsv As String
Dim WsRelCompteur As Worksheet
Dim LastRowC As Integer, LastRowR As Integer
Dim cel As Range

MonCsv = ThisWorkbook.Path & "\rapport-mensuel-des-compteurs-b-a-exporter-vers-tableau-a.csv" '<=== à adapter

Application.ScreenUpdating = False

Set CsvWb = Workbooks.Open(MonCsv, Local:=True, ReadOnly:=True)
Set WsRelCompteur = ThisWorkbook.Sheets("relevés compteurs")

LastRowC = CsvWb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
LastRowR = WsRelCompteur.Cells(Rows.Count, 1).End(xlUp).Row

For Each cel In WsRelCompteur.Range("D3:D" & LastRowR)
    cel.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(cel.Value, CsvWb.Sheets(1).Range("B2:I" & LastRowC), 6, False)
    cel.Offset(0, 2).Value = Application.WorksheetFunction.VLookup(cel.Value, CsvWb.Sheets(1).Range("B2:I" & LastRowC), 7, False)
    cel.Offset(0, 3).Value = Application.WorksheetFunction.VLookup(cel.Value, CsvWb.Sheets(1).Range("B2:I" & LastRowC), 8, False)
Next cel

CsvWb.Close

Application.ScreenUpdating = True

End Sub

Cordialement