HSV
Inventaris
- Lid geworden
- 18 jul 2008
- Berichten
- 20.924
- Office versie
- Bèta Insider Office 365
Kleine aanpassingen gedaan op de bladnamen in de code.
Code:
Sub hsv()
Dim sv, i As Long
With Sheets("BHV registratieformulier Q1")
sv = .Range("a13", .Cells(Rows.Count, 1).End(xlUp)).Resize(, 8).Value2
For i = 1 To UBound(sv)
If sv(i, 2) <> "" And sv(i, 8) = "" Then
sv(i, 8) = "verzonden"
With Sheets("overzicht trainingen Q1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Resize(, 2) = Array(sv(i, 2), sv(i, 3))
.Offset(, Application.Match(sv(i, 7), Sheets("overzicht trainingen Q1").Range("a7:g7"), 0) - 1) = sv(i, 1)
End With
With CreateObject("Outlook.Application").createitem(0)
.To = sv(i, 6)
.Subject = sv(i, 7)
.body = "Beste " & sv(i, 2) & " " & sv(i, 3) & "," & String(2, vbCrLf) & "Op " & sv(i, 1) & " is er de cursus " & sv(i, 7)
.display
'.send
End With
End If
Next i
.Range("a13", .Cells(Rows.Count, 1).End(xlUp)).Resize(, 8).Value2 = sv
End With
End Sub