Excel worksheet via macro versturen

Pagina: 1
Acties:

Vraag


Acties:
  • 0 Henk 'm!

  • alexwel
  • Registratie: Februari 2010
  • Laatst online: 31-07 19:01
Ik heb een excel werkmap met een verkoop aanbod voor meerdere ontvangers voor elke dag. De werkmap heeft twee tabs, waarvan één als bijlage per e-mail verstuurd moet worden naar meerdere ontvangers.

Elke ontvanger moet een unieke e-mail zijn, daarnaast is er één cel in het Excel bestand wat steeds veranderd moet worden naar de naam van de ontvanger.

Nu heb ik niet echt veel ervaring met macro's, maar met wat zoeken, heb ik hiervoor een macro gemaakt die de betreffende tab kopieerd naar een nieuwe werkmap. Vervolgens past deze de cel met de naam van de ontvanger aan, en verstuurd hij deze via Outlook naar de ontvangers.

Voor elke dag heb ik een sub gemaakt.

In principe werkt dit, maar niet heel efficient, aangezien alle e-mail adressen en namen in de macro zijn ingevoerd en het dus voor andere gebruikers wat minder makkelijk is om hier aanpassingen in te maken.
Daarnaast wordt op een enkele computer niet elke e-mail verstuurd, sommige worden overgeslagen, zonder dat ik kan ontdekken waardoor dit komt. Als ik het zelf test, wordt wel alles verstuurd.

Wat ik nu heb is het volgende:
' Kopieer werkblad naar een nieuw bestand

Sheets("Aanbod").Select
Sheets("Aanbod").Copy
Cells.Select


' Kopieer werkblad en plak met alleen waardes

Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Pas de kleur aan voor cel A15:C15

Range("A15").Select

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 14336204
.TintAndShade = 0
.PatternTintAndShade = 0
End With


'Opmaak bedragen naar 2 cijfers achter komma
Range("D20:D47").Select
Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

'Opmaak knop cellen met getallen naar tekst formaat
Range("C20:C46").Select
Selection.NumberFormat = "@"

'Opmaak lengte en aantal per fust cellen naar getal
Range("E20:F46").Select
Selection.NumberFormat = "0"

'Pas kolom breedte aan, kolom met lengte
Columns("E:E").ColumnWidth = 8
Columns("F:F").ColumnWidth = 6

' Schakel meldingen uit

Application.DisplayAlerts = False


' Stel auteur in

ActiveWorkbook.BuiltinDocumentProperties("Author") = "NAAM AUTEUR"
Vervolgens heb ik voor elke ontvanger een blok als volgt:
' Aanbod maken

Range("D15:H15").Select
ActiveCell.FormulaR1C1 = "NAAM ONTVANGER"

Range("G50").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-30]C:R[-1]C)"

Range("G51").Select
ActiveCell.FormulaR1C1 = "=R[-1]C/12"

Range("D15:H15").Select

ActiveWorkbook.SaveAs Filename:= _
"C:\Aanbod\Dinsdag\Aanbod_NAAM ONTVANGER.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

'VERZEND EMAIL

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.to = "ONTVANGER@DOMEIN.NL"
.CC = ""
.BCC = ""
.Subject = "Aanbod"
.Body = ""
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
' On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
De sub wordt dan afgesloten met:
' Schakel meldingen weer in

Application.DisplayAlerts = True

' Sluit actief venster (laatste aanbodlijst)

ActiveWindow.Close

' Ga naar de tab 'TAB1

Sheets("TAB1").Select

End Sub
Waar ik naar toe wil, is dat ik nog een tab heb waar alle ontvangers met naam en e-mailadres in staan ipv dat deze direct in de macro staan.

Nu heb ik met wat zoeken wel een paar opties daarvoor gevonden, maar ik weet niet hoe ik dan toch ervoor kan zorgen dat die ene cel in, het te versturen, excel bestand aangepast wordt naar de naam van de ontvanger.

Kan iemand mij hiermee op weg helpen?

Alle reacties


Acties:
  • 0 Henk 'm!

  • alexwel
  • Registratie: Februari 2010
  • Laatst online: 31-07 19:01
Ik heb inmiddels een oplossing gevonden :)

Acties:
  • +1 Henk 'm!

  • Room42
  • Registratie: September 2001
  • Niet online
alexwel schreef op zaterdag 13 april 2019 @ 20:53:
Ik heb inmiddels een oplossing gevonden :)
Wat dan? Dan heeft de volgende met dezelfde vraag er ook nog wat aan.

"Technological advancements don't feel fun anymore because of the motivations behind so many of them." Bron


Acties:
  • +1 Henk 'm!

  • alexwel
  • Registratie: Februari 2010
  • Laatst online: 31-07 19:01
Room42 schreef op zaterdag 13 april 2019 @ 21:38:
[...]

Wat dan? Dan heeft de volgende met dezelfde vraag er ook nog wat aan.
Ik heb nu wat gemaakt op basis van YouTube: Automation: Send bulk emails using VBA and Outlook

Dit is dus een tabblad waar o.a. e-mailadres, naam en locatie van de bijlage in staat, en dan een loop om ze allemaal te versturen. Per dag heb ik dan een apart tabblad en een aparte mass-mail sub.

Ik ga nog even kijken of ik op basis hiervan, ook de bestanden kan maken, en de locatie daarvan ook automatisch in dit tabblad te zetten.

[ Voor 11% gewijzigd door alexwel op 13-04-2019 21:47 ]