Posts by StrongSteve

'Analyse all Mails in Inbox
Sub AnalyseIncomingMails()
    
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim subject As String
     
    'The NameSpace is the object that gives you access to all Outlook's folders.
    'In Outlook there is only one and it is called "MAPI" which is an acronym
    'for Messaging Application Programming Interface.


    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
     
    'Only check messages, if Inbox is not empty
    If (Inbox.Items.Count > 0) Then
      
        For Each Item In Inbox.Items
            subject = Item.subject
            
            If (InStr(LCase(subject), "appointment:") = 1) Then
                SaveAppointment (subject)
                Item.Delete
            ElseIf (InStr(subject, "Task:") = 1) Then
                SaveTask (subject)
                Item.Delete
            End If
        Next Item
      
    End If
    
End Sub


'Save a new appointment to the calendar
Sub SaveAppointment(ByRef subject As String)
 
    Dim outlookApp As Application
    Dim appItem As AppointmentItem
    Dim appList As Variant
    Dim i As Integer
    
    Set outlookApp = CreateObject("Outlook.Application")
    Set appItem = outlookApp.CreateItem(olAppointmentItem)
    
    'Start and End like "01/01/2004"
    'Subject like "Meeting with Carl"
    'Location like "Somewhere"
        
    'Remove the String "Appointment: " from the Email Subject
    subject = Replace(subject, "appointment: ", "")
    subject = Replace(subject, "Appointment: ", "")
    appList = Split(subject, ";")
    
    'Save Attributes to the new appointment
    On Error Resume Next
    With appItem
        For i = 0 To UBound(appList)
            Select Case i
                Case 0  'Save Start Date
                    .start = Replace(appList(i), ".", "/")
                Case 1  'Save End Date
                    .End = Replace(appList(i), ".", "/")
                Case 2  'Save Subject
                    .subject = appList(i)
                Case 3  'Save Location
                    .Location = appList(i)
                Case 4 'Set Reminder? When?
                    If (appList(i) <> "") Then
                        .ReminderMinutesBeforeStart = appList(i)
                    End If
                Case 5 'Body of Appoinment
                    .Body = appList(i)
            End Select
        Next i
    End With
    On Error GoTo 0
                
    'Save the new Appointment to the calendar
    appItem.Display
    'appItem.Save


End Sub


'Save a new task to the calendar
Sub SaveTask(ByRef subject As String)
 
    Dim outlookApp As Application
    Dim tskItem As TaskItem
    Dim tskList As Variant
    Dim i As Integer
    
    Set outlookApp = CreateObject("Outlook.Application")
    Set tskItem = outlookApp.CreateItem(olTaskItem)
    
    'Start and End like "01/01/2004"
    'Subject like "Meeting with Carl"
    'Location like "Somewhere"
        
    'Remove the String "Appointment: " from the Email Subject
    subject = Replace(subject, "task: ", "")
    subject = Replace(subject, "Task: ", "")
    tskList = Split(subject, ";")
    
    'Save Attributes to the new appointment
    On Error Resume Next
    With tskItem
        For i = 0 To UBound(tskList)
            Select Case i
                Case 0  'Save Due To Date
                    .DueDate = Replace(tskList(i), ".", "/")
                    .startDate = Now
                Case 1  'Save Subject
                    .subject = tskList(i)
                Case 2 'Body of Appoinment
                    .Body = tskList(i)
            End Select
        Next i
    End With
    On Error GoTo 0
                
    'Save the new Appointment to the calendar
    tskItem.Display
    'tskItem.Save


End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim valueOfB3 As Integer
    
    valueOfC3 = Range("C3").Value
    
    'Value of C3 has to be 12, 24 or 36
    If ((valueOfC3 <> 12) And (valueOfC3 <> 24) And (valueOfC3 <> 36)) Then
        MsgBox ("Value of C3 has to be 12, 24 or 36!")
    End If
    
    'Calculate the value for D4
    If (valueOfC3 = 12) Then
        Range("D4").Value = Range("B3") * Range("A1")
    ElseIf (valueOfC3 = 24) Then
        Range("D4").Value = (Range("B3") * (Range("A1") * 0.95) * 24) / 24
    ElseIf (valueOfC3 = 36) Then
        Range("D4").Value = (Range("B3") * (Range("A1") * 0.85) * 36) / 36
    End If
End Sub