Excel 通过企业登录门户访问VBA和GMail

我一直想弄明白，但我做不到。我正在为一个制造环境做一个VBA项目，在这个项目中，叉车司机需要能够直接通过电子邮件将物料移动的最新列表发送给职员，由他们在一个新的数据库系统中进行记录

这个想法是，在一个模块中有一组硬编码的电子邮件地址，在驾驶员选择特定班次的值班职员后，单击一下即可将电子表格直接发送到电子邮件

驾驶员在轮班时选择职员的实用程序非常简单，下面是5个不同的职员，分散在不同的轮班上，但重复代码没有什么意义：

Private Sub cboClerk_Change()

With UserForm1.cboClerk

    If .ListIndex = 0 Then 'listindex goes from 0 to 4

        UserForm1.lblEmail = "fname.lname@company.com"
        ThisWorkbook.Sheets(1).Range("C1") = UserForm1.lblEmail
        ThisWorkbook.Sheets(1).Range("A1") = "Clerk on duty: First, Last"


    End If

end with

下一部分是给我带来的问题。有很多从VBA访问gmail的例子，我已经尝试过修改，这是我能够找到的最有希望的解决方案，我声称没有任何作者身份：

Sub ActivateGmail()


Dim newMail As CDO.Message

Set newMail = New CDO.Message

'enable SSL authentication

newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'make SMTP authenticaion Enabled = true (1)

newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

'set the SMTP server and port details
'to get these details you can get on the settings page of your Gmail account

newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 2

newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 587


'set your credentials of your Gmail account

newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "firstandlast@company.com"

newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"

'update the configuration fields
newMail.Configuration.Fields.Update

'set all email properties

With newMail

    .Subject = "Test mail"
    .From = "firstandlast@company.com"
    .To = "firstandlast@company.com"
    .TextBody = "I gots it!"
End With

newMail.Send
MsgBox ("Mail has been sent")

'set the newMail variable to nothing

Set newMail = Nothing

End Sub

有一个公司门户，它有一个全球ID和密码，可以访问gmail，我相信这会阻止我使用上述解决方案直接访问gmail。尝试从gmail.com登录会重定向到公司登录页面，该页面有自己的登录凭据。我暂时采取了以下措施：

Sub try6()

ThisWorkbook.FollowHyperlink Address:="http://www.gmail.com", NewWindow:=True

End Sub

…如果司机幸运地已经登录到gmail，那该怎么办呢？但仍然需要手动发送电子邮件。由于我工作的工厂的wifi不活跃，登录超时，这不是一个充分的解决方案。因此，我想知道如何将企业登录门户作为VBA gmail解决方案的一部分合并

---

提前谢谢你。

难以置信。我想我明白了

首先，本页作者的代码与第一篇文章相似：

也就是说：

Public Sub sendmail()

Dim mail As CDO.Message
Dim config As CDO.Configuration

Set mail = CreateObject("CDO.message")
Set config = CreateObject("Cdo.configuration")

config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
config.Fields(cdoSMTPServer).Value = "aspmx.l.google.com"
config.Fields(cdoSMTPServerPort).Value = 25 '25
config.Fields(cdoSMTPAuthenticate).Value = cdoBasic  'cdoNTLM  'cdoBasic 'cdoNTLM
config.Fields(cdoSendUserName).Value = "fname.lname@company.com" 'domain is not gmail
config.Fields(cdoSendPassword).Value = "mypassword"
config.Fields.Update

Set mail.Configuration = config

With mail

    .To = "fname.lname@company.com"
    .From = "fname.lname@company.com"
    .Subject = "Hello"
    .TextBody = "Plain email with CDO"

    '.addattachment "Path"

    .Send

End With

Set config = Nothing
Set mail = Nothing

End Sub

解决这个问题的方法是将

smtp.gmail.com

替换为

aspmx.l.google.com

。它所做的是完全绕过公司登录门户，可以从司机的帐户发送电子邮件，甚至不需要司机登录。这比我希望的还要好

身份验证不能是465或587，这是Google的传出端口，因为

Config.fields.update

行将抛出错误。它必须是

cdoBasic

或

cdoNTLM

，这两者都可以用来发送电子邮件。目前，我还不知道还有比这些更好的选择

SMTPServerPort应该（必须？）为25

---

希望这对任何面临类似问题的人都有效。

那么，您成功使用CDO了吗？确切的问题是什么，您是否有任何错误？你允许了吗？是的。我在gmail中启用了这个选项。我收到的错误挂断在发送线路上，显然是由于错误的凭据。因此，该公司使用gmail，但它与登录门户是一个不同的域，这阻止了与gmail的直接连接。我可以在今天晚些时候或明天详细说明错误消息。请在行

Set newMail=New CDO.Message

后立即尝试

newMail.Configuration.Load-1

。您有代理吗？如果有，是否需要输入代理凭据以访问internet？我不需要代理凭据来访问internet，但要通过公司门户访问我的电子邮件，我需要代理凭据。我尝试了你的建议，但我得到了一个运行时3749错误，告诉我字段更新失败，无法检查单个字段对象的Status属性。我会继续寻找…我正在探索一个角度，因为在进入gmail之前需要公司登录，邮件服务器可能与smtp.gmail.com有不同的名称？