Question

如果我点击一个按钮，应该在第一个空单元格E列中捕获时间，从单元格E5开始，如果该单元格不为空，那么它应该自动转到下一个单元格E6然后是E7 ...

以下是我目前使用的代码，但它不起作用：

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

使用此

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

Answer 2

无需使用SendKeys方法以编程方式发送电子邮件。相反，我建议使用MailItem类的Send方法。有关示例代码，请参阅Using Automation to Send a Microsoft Outlook Message文章。

 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

您也可以在How to automate Outlook from another program文章中详细了解相关内容。

捕获下一个空单元格中的当前时间

2 个答案: