Consulting

Results 1 to 6 of 6

Thread: Help with macro to insert date at the end of oulook contact body

  1. #1
    VBAX Regular
    Joined
    May 2018
    Posts
    50
    Location

    Question Help with macro to insert date at the end of oulook contact body

    I have found a macro that Inserts date at the top of the body

    Insert date at the top of the body
    
    Public Sub AddNoteTop()
      Dim DefaultMsg$
     
      DefaultMsg = ""
     
      AddNote_Ex Application.ActiveInspector, DefaultMsg
    End Sub
    Private Sub AddNote_Ex(Inspector As Outlook.Inspector, Optional Msg As String)
      Dim WdSel As Word.Selection
      Dim p&
    Msg = Format(Date, "mm/dd/yyyy", vbUseSystemDayOfWeek, vbUseSystem) & _
        ": " & Msg
      Msg = vbCrLf & "---" & vbCrLf & Msg
      Set WdSel = GetCurrentWordSelection(Inspector)
      p = Len(Msg) - 2
      WdSel.Start = 0
      WdSel.End = 0
      WdSel.InsertBefore Msg
      WdSel.Start = WdSel.Start + p
      WdSel.End = WdSel.Start
    End Sub
    Private Function GetCurrentWordSelection(OpenInspector As Outlook.Inspector) As Word.Selection
      Dim Doc As Word.Document
      Dim Wd As Word.Application
     
      Set Doc = OpenInspector.WordEditor
      Set Wd = Doc.Application
      Set GetCurrentWordSelection = Wd.Selection
    End Function
    Can you Pls?
    Be so kind and tell me how to insert the text at the end of the body of a Contact Item in Outlook 2019
    And if possible in green
    THX in advance

  2. #2
    The following will do that
    Public Sub AddDateEnd()
    'Graham Mayor - https://www.gmayor.com - Last updated - 09 Nov 2020 
    Dim olItem As ContactItem
    Dim olInsp As Inspector
    Dim wdDoc As Object
    Dim oRng As Object
        On Error Resume Next
        Select Case Outlook.Application.ActiveWindow.Class
            Case olInspector
                Set olItem = ActiveInspector.currentItem
            Case olExplorer
                Set olItem = Application.ActiveExplorer.Selection.Item(1)
        End Select
        With olItem
            .Display
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            oRng.collapse 0 'set to1 to put the date at the start of the body
            oRng.Text = Format(Date, "mm/dd/yyyy")
            oRng.Font.Color = RGB(0, 128, 0) 'green
            .Save
            .Close 0
        End With
    lbl_Exit:
        Set olItem = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    May 2018
    Posts
    50
    Location
    THX great

    Can you pls help me on to

    oRng.Text = Format(Date, "mm/dd/yyyy") & " Call:" & vbCrLf ' could you pls be so kind and ad also actual time HH.MM

    .Save ' Please place the cursor at the end of what has been inserted to be able to start writing

    .Close 0 'Do not Close for further inserting text there

    Public Sub AddDateEnd()
    'Graham Mayor - https://www.gmayor.com - Last updated - 09 Nov 2020
    Dim olItem As ContactItem
    Dim olInsp As Inspector
    Dim wdDoc As Object
    Dim oRng As Object
        On Error Resume Next
        Select Case Outlook.Application.ActiveWindow.Class
            Case olInspector
                Set olItem = ActiveInspector.CurrentItem
            Case olExplorer
                Set olItem = Application.ActiveExplorer.Selection.Item(1)
        End Select
        With olItem
            .Display
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            oRng.Collapse 0 'set to1 to put the date at the start of the body
            oRng.Text = Format(Date, "mm/dd/yyyy") & " Call:" & vbCrLf 'Pls ad also actual time HH.MM
            oRng.Font.Color = RGB(0, 128, 0) 'green
            .Save
            ' place the cursor at the end of what has been inserted to be able to start writing
            '.Close 0 'Do not Close for further inserting text there
        End With
    lbl_Exit:
        Set olItem = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub
    Hope for further help
    THX

  4. #4
    The following will do what you ask, but it is not clear where you want the extra text or what colour you want for the rest but you should be able to work out how to set the ranges from that shown below.

    Public Sub AddDateEnd()
    'Graham Mayor - https://www.gmayor.com - Last updated - 09 Nov 2020
    Dim olItem As ContactItem
    Dim olInsp As Inspector
    Dim wdDoc As Object
    Dim oRng As Object
        On Error Resume Next
        Select Case Outlook.Application.ActiveWindow.Class
            Case olInspector
                Set olItem = ActiveInspector.currentItem
            Case olExplorer
                Set olItem = Application.ActiveExplorer.Selection.Item(1)
        End Select
        With olItem
            .Display
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            If Len(oRng) > 2 Then
                oRng.collapse 0
                oRng.Text = vbCrLf
            End If
            oRng.collapse 0
            oRng.Text = Format(Date, "mm/dd/yyyy") & " Call:" & vbCrLf & Format(Time, "HH.MM ")
            oRng.Paragraphs(1).Range.Font.Color = RGB(0, 128, 0)    'green
            ' place the cursor at the end of what has been inserted to be able to start writing
            oRng.collapse 0
            oRng.Select
            .Save
            '.Close 0 'Do not Close for further inserting text there
        End With
    lbl_Exit:
        Set olItem = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Regular
    Joined
    May 2018
    Posts
    50
    Location
    Great THX

    What I found is that the cursor is in the field beyond the insert but The focus is still in another field. Where it was when running the macro!
    So when I want start to write the result of the call - The text is not in the body! It goes to the field where the cursor was!

    Can You Pls help again?

    Public Sub AddDateEnd()'Graham Mayor - https://www.gmayor.com - Last updated - 09 Nov 2020
    Dim olItem As ContactItem
    Dim olInsp As Inspector
    Dim wdDoc As Object
    Dim oRng As Object
        On Error Resume Next
        Select Case Outlook.Application.ActiveWindow.Class
            Case olInspector
                Set olItem = ActiveInspector.CurrentItem
            Case olExplorer
                Set olItem = Application.ActiveExplorer.Selection.Item(1)
        End Select
        With olItem
            .Display
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            If Len(oRng) > 2 Then
                oRng.Collapse 0
                oRng.Text = vbCrLf
            End If
            oRng.Collapse 0
            oRng.Text = vbCrLf & Format(Date, "mm/dd/yyyy") & "-" & Format(Time, "HH.MM ") & " Call: "
            oRng.Paragraphs(2).Range.Font.Color = RGB(0, 128, 0)    'green
            ' place the cursor at the end of what has been inserted to be able to start writing
            oRng.Collapse 0
            oRng.Select
            ' set focus un cursr position to be able to enter text there after executing the macro
            '.Save 'saving manualy With Save& close
            '.Close 0 'Do not Close for further inserting text there
        End With
    lbl_Exit:
        Set olItem = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub

  6. #6
    VBAX Regular
    Joined
    May 2018
    Posts
    50
    Location
    Maybe it is not clear?

    This macro insertsDATE - Time & MESSAGE: at the end of an Outlook contact form.
    This is working fineso far. But after handling this, I have no "real" focus, which meanswhen I press any key, nothing is typed to the body. I can see the cursor but itis not blinking. Hope you understand what I mean.
    The cursor is stillin this field or position where it was before starting the macro
    How to set focusthere to be able to start writing

    Public Sub AddDateEnd()'Graham Mayor - https://www.gmayor.com - Last updated - 09 Nov 2020
    Dim olItem As ContactItem
    Dim olInsp As Inspector
    Dim wdDoc As Object
    Dim oRng As Object
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
    Case olInspector
    Set olItem = ActiveInspector.CurrentItem
    Case olExplorer
    Set olItem = Application.ActiveExplorer.Selection.Item(1)
    End Select
    With olItem
    .Display
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor
    Set oRng = wdDoc.Range
    If Len(oRng) > 2 Then
    oRng.Collapse 0
    oRng.Text = vbCrLf
    End If
    oRng.Collapse 0
    oRng.Text = vbCrLf & Format(Date, "mm/dd/yyyy") & "-" & Format(Time, "HH.MM ") & " Call: "
    oRng.Paragraphs(2).Range.Font.Color = RGB(0, 128, 0) 'green
    ' place the cursor at the end of what has been inserted to be able to start writing
    oRng.Collapse 0
    oRng.Select
    ' set focus un cursr position to be able to enter text there after executing the macro
    '.Save 'saving manualy With Save& close
    '.Close 0 'Do not Close for further inserting text there
    End With
    lbl_Exit:
    Set olItem = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
    End Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •