来自 Excel 使用 Gmail 的电子邮件

Question

我正在尝试在保存工作簿后自动生成电子邮件。我不想在电子邮件中发送工作簿，只是向一列人员发送电子邮件通知，说它有一个新条目，所以他们实际上必须打开它并回复（如果我可以放 link到可以工作的电子表格的位置）。此外，工作簿是 "shared"，因此多人可以同时编辑它，所以我认为如果从电子邮件下载它，它不会保持 "shared" 并继续更新。大约 25 人可以访问此电子表格，任何人都可以 enter/edit 一个条目。最终，我希望它仅在特定列中的数据为 entered/edited 并保存时才发送电子邮件。

我的代理机构使用 Gmail，但我们的电子邮件地址中没有 @gmail.com。相反，我们以某种方式通过 gmail 使用我们的 .gov 电子邮件地址。我不确定这是否相关，但我想我会提到它。我搜索了几个在线论坛，但似乎找不到任何东西。

有人知道执行此操作的任何代码吗？

我是 VBA 的新手，我可以使用电子邮件部分，但我希望它在保存工作簿时通过电子邮件发送。这是我目前使用的代码：

Sub CDO_Mail_Small_Text()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    '    Dim Flds As Variant

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxx@xxx.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxx"
        .Update    'Let CDO know we have change the default configuration for this message
    End With




    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    With iMsg
        Set .Configuration = iConf
        .To = "xxx@xxx.com"
        .CC = ""
        .BCC = ""
        .From = """name"" <xxx@xxx.com>"
        .Subject = "test"
        .TextBody = strbody
        .Send
    End With

End Sub

我收到这个错误

Answer 1

我没看到你在哪里 .update .fields 配置。试试这个：

    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxx@xxx.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxx"
    .Update 'Let CDO know we have change the default configuration for this message
 End With

Answer 2

好吧，我想通了，如果我将变量放在 subs 之外，然后在第一个 sub 中调用第二个 sub，并为 .fields 配置添加 .update（感谢 Tim！），它就可以工作:

Dim iMsg As Object
Dim iConf As Object
Dim strbody As String

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Call CDO_Mail_Small_Text
End Sub

Private Sub CDO_Mail_Small_Text()

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1    ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxx@xxx.com"
  .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxx"
  .Update 'Let CDO know we have changed the default configuration for this message
End With

strbody = "Hi there" & vbNewLine & vbNewLine & _
      "This is line 1" & vbNewLine & _
      "This is line 2" & vbNewLine & _
      "This is line 3" & vbNewLine & _
      "This is line 4"

With iMsg
  Set .Configuration = iConf
    .To = "xxx@xxx.com"
    .CC = ""
    .BCC = ""
    .From = """name"" <xxx@xxx.com>"
    .Subject = "test"
    .TextBody = strbody
    .Send
End With

End Sub

Answer 3

简单的 Sendkeys 解决方案。您必须登录到 gmail

Sub ActivateGmail()
    MessageText = Range("Email!StockOptionAnalysis")
    Handle = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
    RetVal = Shell(Handle, 1) '      Open
    Application.Wait Now + TimeValue("00:00:03")

    SendKeys ("https://mail.google.com/mail/u/0/#inbox?compose=new"), True
    SendKeys ("{ENTER}"), True
    Application.Wait Now + TimeValue("00:00:03")

    SendKeys ("""boss"" <wife@gmail.com>"), True
    SendKeys ("{ENTER}"), True
    Application.Wait Now + TimeValue("00:00:03")
    SendKeys ("{TAB}"), True

    SendKeys ("Optigon"), True
    Application.Wait Now + TimeValue("00:00:03")
    SendKeys ("{TAB}"), True

    SendKeys (MessageText), True
    Application.Wait Now + TimeValue("00:00:03")

    SendKeys ("{TAB},{ENTER}"), True
    Application.Wait Now + TimeValue("00:00:03")
    SendKeys ("%{F4}"), True
'       Adjust the wait time as needed
End Sub

来自 Excel 使用 Gmail 的电子邮件

email from Excel using Gmail

email

excel

gmail

vba