VBA bijhouden naar wie email is verstuurt

[ISchouten]

Hoi ik heb een VBA macro waarmee ik verschillende leveranciers een email verstuur als ze iets moeten leveren binnen 2 weken of als ze een bestelling niet hebben bevestigd, maar nu worden de emails dus verstuurt op basis van een bijlage (is die beschikbaar dan verstuurt die een email). Ik zou graag willen dat ik aan het einde een overzicht heb met naar wie er een email is gestuurd, zodat ik niet door mijn outlook send map heen hoeft te graven en het handmatig moet noteren.

Is er iemand die weet welke code ik hiervoor moet gebruiken? Misschien eerst een filter op de main file dat die alle duplicaten eruit verwijderd en dan de overige namen vergelijkt met mijn database?

Als basis gebruik ik een data export in Excel die altijd dezelfde opmaak heeft

 

[edmoor]

En waarin heb je die macro?
Outlook? Excel? Word? Access?

 

[ISchouten]

Vergelijking

Mijn excuses hierbij meer context,

Ik heb nu het volgende gemaakt vanuit een export file in excel haal ik de lijst met leveranciers die een email gaan ontvangen. Nu heb ik zo aangepast dat hij deze lijst aanpast zodat ik alleen een lijst heb met het leverancier nummer en zijn naam (sheet 2)

Nu wil ik dat hij checkt of het leveranciers nummer van Sheet2 ook op Sheet3 voorkomt zo ja kopieer deze dan naar Sheet4 (leveranciers nummer + naam).

Alvast bedankt voor je hulp!

 

[ISchouten]

Sub SendMailListReclamatieOrders()

Hier een andere code wat ik net liet zien is een omweg, maar eigenlijk moet het in onderstaande worden verwerkt dat als hij een email verstuurd dat de leverancier in een nieuw overzicht/sheet wordt gezet



Sub SendMailListReclamatieOrders()
Dim OutApp As Object
Dim OutMail As Object
Set WBMacro = ActiveWorkbook
Set WBMacroList = Sheets("Macro")
Set WBMailList = Sheets("Leveranciers")
Set OutApp = CreateObject("Outlook.Application")
If Len(Dir(WBMacro.Path & "" & Year(Now) & "\Week " & WorksheetFunction.WeekNum(Now, vbMonday) & "\Reclamatie", vbDirectory)) = 0 Then
MsgBox ("No 'Reclamatie' files have been created for week " & WorksheetFunction.WeekNum(Now, vbMonday) & " yet")
Exit Sub
End If
With WBMailList
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
'.Range(.Cells(2, 1), Cells(LastRow, LastCol)).Sort Key1:=Cells(2, "A"), Order1:=xlAscending, _
' Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 4
emailsSent = 0

For i = iStart To LastRow
If StrComp(WBMacroList.Range("I" & 4).Value, WBMailList.Range("G" & i).Value) = 0 Or StrComp(WBMacroList.Range("I" & 4).Value, "Alle Productgroepen") = 0 Then

Set OutMail = OutApp.CreateItem(0)

'Change only Mysig.htm to the name of your signature
SignatureName = WBMailList.Range("F" & 2).Value
SignatureName = Replace(SignatureName, " ", "%20")
'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures" & WBMailList.Range("F" & 2).Value & ".htm"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Signature = VBA.Replace(Signature, (SignatureName & "_files"), (Environ("appdata") & "\Microsoft\Signatures" & SignatureName & "_files"))
Else
Signature = WBMailList.Range("F" & 1).Value
End If


On Error Resume Next
If Dir(WBMacro.Path & "" & Year(Now) & "\Week " & WorksheetFunction.WeekNum(Now, vbMonday) & "\Reclamatie\Reclamatie overzicht " & WBMailList.Range("B" & i).Value & ".xlsx") <> "" Then

With OutMail
.To = WBMailList.Range("C" & i).Value
.CC = ""
.BCC = ""
If WBMailList.Range("D" & i).Value = "Nederlands" Then
.Subject = "Reclamatie order overzicht week " & WorksheetFunction.WeekNum(Now, vbMonday)
.HTMLBody = "<font face=""calibri"" style=""font-size:11pt;"">" & WBMailList.Range("E" & i).Value & "<br>" & "<br>" & WBMailList.Range("B" & 1).Value & "<br>" & "<br>" & "<font>" & Signature
Else
.Subject = "Reclamation order overview week " & WorksheetFunction.WeekNum(Now, vbMonday)
.HTMLBody = "<font face=""calibri"" style=""font-size:11pt;"">" & WBMailList.Range("E" & i).Value & "<br>" & "<br>" & WBMailList.Range("B" & 2).Value & "<br>" & "<br>" & "<font>" & Signature
End If
'.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
.Attachments.Add (WBMacro.Path & "" & Year(Now) & "\Week " & WorksheetFunction.WeekNum(Now, vbMonday) & "\Reclamatie\Reclamatie overzicht " & WBMailList.Range("B" & i).Value & ".xlsx")
.Send 'or use .Display
emailsSent = emailsSent + 1
End With
On Error GoTo 0
End If
End If
Next i
MsgBox ("Totaal " & emailsSent & " reclamatie emails vertuurd.")
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[edmoor]

Zet de code in #4 even in codetags.

In Excel kan je gewoon op een apart werkblad bijhouden aan wie er wanneer is gemailt.