Forum Discussion

WesLo9's avatar
WesLo9
Copper Contributor
Mar 13, 2024

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 

  • WesLo9 

    For j = 2 To 13

    should be

    For j = 3 To 14

    and

    For j = 14 To 25

    should be

    For j = 15 to 26

  • WesLo9 

    For j = 2 To 13

    should be

    For j = 3 To 14

    and

    For j = 14 To 25

    should be

    For j = 15 to 26

    • WesLo9's avatar
      WesLo9
      Copper Contributor
      Dag 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.

Resources