Question

我一直试图解决这个问题，但我不能。我正在开发一个用于制造环境的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解决方案的一部分？

提前谢谢。

Answer 1

原谅。我想我想通了。

首先，在此页面上向作者表示与第一篇文章类似的代码：http://www.codekabinett.com/rdumps.php?Lang=2&targetDoc=send-email-access-vba-cdo

即便：

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.

希望这适用于遇到类似问题的其他人。

VBA和GMail通过企业登录门户

1 个答案: