email from Excel using Gmail

问题

I'm trying to have an email auto generate after a workbook is saved. I don't want to send the workbook in the email, just an email notification to a list of people to say that it has a new entry so they actually have to open it and respond (if I could put a link to the location of the spreadsheet that would work). Also the workbook is "shared" so multiple people can edit it at once, so I don't think it will remain as "shared" and continue to update if it is downloaded from an email. About 25 people have access to this spreadsheet and anyone can enter/edit an entry. Ultimately, I'd like it to send an email only if data is entered/edited in a specific column and then saved.

My agency uses Gmail but our email addresses do not have @gmail.com in them. Instead we are using our .gov email addresses through gmail somehow. I'm not sure if this is even relevant but thought I'd mention it. I've searched several online forums, but can't seem to find anything.

Does anyone know of any code to do this?

I'm a novice with VBA and I got the email part to work but I want it to email when the workbook is saved. This is the code I am currently using:

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

I get this error

回答1:

Well I figured out that if I put the variables outside the subs and then call the second sub in the first sub, as well as adding in the .update for the .fields configuration (thanks Tim!), it works:

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

回答2:

I don't see where you .update the .fields configuration. Try this:

    .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

回答3:

Simple Sendkeys solution. You must be logged in to 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

来源：https://stackoverflow.com/questions/33607082/email-from-excel-using-gmail

标签

excel

excel-vba

gmail

vba