Forum Discussion
WesLo9
Mar 13, 2024Copper Contributor
Visual Basic Script Problems with Excel
Hello, I'm having trouble writing a script in Visual basic with the help of ChatGPT. for some reason it adds an email in the first cell of the table and i have no idea why. ChatGPT cant fix it unfortunately. The script is supposed to take information out of an excel file and use that to compile an email and sent it from outlook.
This is my script:
Sub Planning_script()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim ExcelApp As Object
Dim Sheet As Object
Dim LastRow As Integer
Dim Row As Integer
Dim Name As String
Dim email As String
Dim WeekHours As String
Dim JobFunction As String
Dim Content As String
Dim timeZone As String
Dim value As Variant
Dim kleur As Variant
' Maak een nieuw Outlook-object
Set OutlookApp = CreateObject("Outlook.Application")
' Open het huidige spreadsheet
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = False ' Voorkomt dat Excel zichtbaar wordt
Set Sheet = ExcelApp.Workbooks.Open("C:\Wesley\Planning2.xlsx").Sheets("Planning2") ' Verander het pad naar je bestand en de naam van het blad
' Stel de juiste tijdzone in
timeZone = "Europe/Amsterdam"
' Bepaal het aantal rijen in het werkblad
LastRow = Sheet.Cells(Sheet.Rows.Count, "A").End(-4162).Row ' -4162 betekent xlUp
' Loop door elke rij in het werkblad, beginnend bij rij 2 (rij 1 zijn de koppen)
For Row = 2 To LastRow
Name = Sheet.Cells(Row, 1).value ' De naam staat in de eerste kolom (kolom A)
email = Sheet.Cells(Row, 2).value ' Het e-mailadres staat in de tweede kolom (kolom B)
WeekHours = Sheet.Cells(Row, 27).value ' Haal de totale weekuren op uit kolom AA
JobFunction = Sheet.Cells(Row, 28).value ' Haal de functie op uit kolom AB
' Maak een HTML-tabel met de inhoud van de planning voor de huidige persoon
Content = "<h2>Planning</h2>"
Content = Content & "<h3>Rooster voor " & Name & "</h3>"
Content = Content & "<table border='1'>"
' Loop door elke dag van de week en voeg waarden toe aan de HTML-tabel
Content = Content & "<tr><th colspan='4'>Maandag</th><th colspan='4'>Dinsdag</th><th colspan='4'>Woensdag</th></tr>"
Content = Content & "<tr><th>Begin</th><th>Eind</th><th>Pauze</th><th>Totaal</th><th>Begin</th><th>Eind</th><th>Pauze</th><th>Totaal</th><th>Begin</th><th>Eind</th><th>Pauze</th><th>Totaal</th></tr>"
Content = Content & "<tr>"
For j = 2 To 13 ' Loop through each day of the week (Monday, Tuesday, Wednesday)
value = Sheet.Cells(Row, j).value
kleur = Sheet.Cells(Row, j).Interior.Color ' Haal de kleur van de achtergrond op voor deze cel
If IsDate(value) Then
value = Format(value, "HH:mm") ' Zet de waarde om naar een leesbare tijd
End If
' Voeg de waarde en achtergrondkleur toe aan de cel in de tabel
Content = Content & "<td style='background-color:" & RGB(kleur Mod 256, kleur \ 256 Mod 256, kleur \ 65536 Mod 256) & "; height: 23.5px'>" & value & "</td>"
Next j
Content = Content & "</tr>"
Content = Content & "</tr><tr><td colspan='12' style='height: 10px; font-size: 1px; line-height: 0; padding: 0; margin: 0;'><br></td></tr>"
Content = Content & "</tr>"
' Voeg de tweede set kolommen toe voor donderdag, vrijdag en zaterdag
Content = Content & "<tr><th colspan='4'>Donderdag</th><th colspan='4'>Vrijdag</th><th colspan='4'>Zaterdag</th></tr>"
Content = Content & "<tr><th>Begin</th><th>Eind</th><th>Pauze</th><th>Totaal</th><th>Begin</th><th>Eind</th><th>Pauze</th><th>Totaal</th><th>Begin</th><th>Eind</th><th>Pauze</th><th>Totaal</th></tr>"
Content = Content & "<tr>"
For j = 14 To 25 ' Loop through each day of the week (Thursday, Friday, Saturday)
value = Sheet.Cells(Row, j).value
kleur = Sheet.Cells(Row, j).Interior.Color ' Haal de kleur van de achtergrond op voor deze cel
If IsDate(value) Then
value = Format(value, "HH:mm") ' Zet de waarde om naar een leesbare tijd
End If
' Voeg de waarde en achtergrondkleur toe aan de cel in de tabel
Content = Content & "<td style='background-color:" & RGB(kleur Mod 256, kleur \ 256 Mod 256, kleur \ 65536 Mod 256) & "; height: 23.5px'>" & value & "</td>"
Next j
Content = Content & "</tr>"
' Voeg de totale weekuren en functie toe onder de planning
Content = Content & "<tr><th colspan='6'>Werkuren deze Week</th><th colspan='6'>Functie</th></tr>"
Content = Content & "<tr></tr>" ' Totaal Weekuren en Functie
Content = Content & "<tr><td colspan='6' style='vertical-align: middle; text-align: center;'>" & WeekHours & "</td><td colspan='6' style='vertical-align: middle; text-align: center;'>" & JobFunction & "</td></tr>"
Content = Content & "</table>"
' Verstuur de e-mail alleen als het e-mailadres geldig is
If email <> "" Then
Set OutlookMail = OutlookApp.CreateItem(0) ' 0 betekent een nieuw e-mailbericht
With OutlookMail
.To = email
.Subject = "Jouw rooster"
.HTMLBody = Content
' Verstuur de e-mail
.Display ' Toon het e-mailbericht in de conceptenmap van Outlook
End With
Set OutlookMail = Nothing
End If
Next Row
' Sluit het Excel-bestand
ExcelApp.Quit
Set ExcelApp = Nothing
End Sub
This is my excel file:
When i run the script (or macro) i get this result:
As you can it randomly adds their mail to the first cell.
If anyone could help me with this the i'd greatly appreciate it.
thanks in advance!
NikolinoDE mtarler HansVogelaar
- WesLo9Copper ContributorDag Hans, hartstikke bedankt!
In mijn oorspronkelijke script heb ik JavaScript gebruikt, waarbij ik me hield aan de conventie dat indexen beginnen bij 0. ChatGPT datzelfde principe weer overgenomen toen ik hem vroeg om het script te herschrijven in VB.
Bedankt voor je waardevolle assistentie, dit had ik zelf nooit gevonden.