checking it out now
ok here is the revised code with few lines taken out, which were to do with me setting up a data string saved to the clipboard for pasting into another application, my fault
'****
' procedure to assist in deletion of user accounts cutting down the keystrokes
' prompt for username(s) and create a calendar appointment
' copy a piece of text to the clipboard, to be pasted into Easy Vista Update box
'
' Author Jim Ward
' Creation 16th April 2010
'****
'
Sub DeleteAccountAppoint()
Dim EndDate As Date
Dim FutureDate As Date
'
'****
' Get a list of username(s)
'****
'
Dim strName As String
strName = InputBox(Prompt:="Enter User(s) To Be Deleted", _
Title:="ENTER USER(S) NAME", Default:="Users Name here")
If strName = "Users Name here" Or strName = vbNullString Then
Exit Sub
End If
'
'****
' Get Todays date, add 30 days
' check if saturday or sunday advance if needed to Monday
'****
'
FutureDate = Date + 30
wDay = Weekday(FutureDate, vbMonday)
If wDay = 6 Then
FutureDate = FutureDate + 2
End If
If wDay = 7 Then
FutureDate = FutureDate + 1
End If
'
'****
' Add 8 hours as the above sets to midnight, then add 15mins for 08:15
'****
'
FutureDate = FutureDate + TimeSerial(8, 0, 0)
EndDate = FutureDate + TimeSerial(0, 15, 0)
'
'****
' Create appointment and copy a constant string to the clipboard
'****
'
CreateAppointment "Account Deletion", "Delete Accounts for " + strName, FutureDate, EndDate, False
End Sub
'
'****
'Function to create calendar item, nabbed from my friend google
'****
'
Public Function CreateAppointment(SubjectStr As String, BodyStr As String, StartTime As Date, EndTime As Date, AllDay As Boolean)
Dim OlApp As Outlook.Application
Dim Appt As Outlook.AppointmentItem
Set OlApp = CreateObject("Outlook.Application")
Set Appt = OlApp.CreateItem(olAppointmentItem)
Appt.Subject = SubjectStr
Appt.Start = StartTime
Appt.End = EndTime
Appt.AllDayEvent = AllDay
Appt.Body = BodyStr
Appt.Save
Set Appt = Nothing
Set OlApp = Nothing
End Function
