Capture current time in next empty cell - vba

Question

If I click on a button the time should be captured in Column E in the first empty cell starting at cell E5 and if that cell is not empty then it should automatically go to the next cell E6 then E7 ...
Here is the code that I use currently, but it doesn't work:
Sub Button4_Click()
ActiveSheet.Unprotect "pramtesh"
ActiveWorkbook.Unprotect "pramtesh"
ActiveSheet.Value = Time()
ActiveSheet.Protect "pramtesh"
ActiveWorkbook.Protect "pramtesh"
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)
With olMailItm
.To = ""
.CC = ""
.Subject = ""
.Body = ""
.Display
Application.Wait (Now)
Application.SendKeys "%s"
End With
Set olMailItm = Nothing
Set olApp = Nothing
End Sub

Answer 1

There is no need to use the SendKeys method for sending an email programmatically. Instead, I'd suggest using the Send method of the MailItem class. See the Using Automation to Send a Microsoft Outlook Message article for a sample code.
Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Nancy Davolio")
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Michael Suyama")
objOutlookRecip.Type = olCC
' Add the BCC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "This is the body of the message." &vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each ObjOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Sub
Also you can read more about that in the How to automate Outlook from another program article.

Answer 2

use this
Sub Button4_Click()
Dim iCounter%, Dest As Variant, SDest$, Lrow&
Dim olApp As Object: Set olApp = CreateObject("Outlook.Application")
Dim olMailItm As Object: Set olMailItm = olApp.CreateItem(0)
'determinate the last used cell in column "E"
Lrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
'additional verification
If Lrow < 5 Then 'if last used cell before [E5] then will be used [E5]
Lrow = 5
Else 'otherwise move to the next cell after last filled cell
Lrow = Lrow + 1
End If
ActiveSheet.Unprotect "pramtesh": ActiveWorkbook.Unprotect "pramtesh"
ActiveSheet.Cells(Lrow, "E").Value = Time() 'insert time into the cell
ActiveSheet.Protect "pramtesh": ActiveWorkbook.Protect "pramtesh"
With olMailItm
.To = ""
.CC = ""
.Subject = ""
.Body = ""
.Display
Application.Wait (Now)
Application.SendKeys "%s"
End With
Set olMailItm = Nothing: Set olApp = Nothing
End Sub