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
