Question

Sub SendEmailUsingGmail()
Dim Text As String, StrPath As String, StrFile As String
Dim Text2 As String
Dim Text3 As String
Dim i As Integer
Dim j As Integer
Dim NewMail As CDO.Message



i = 1
Do While Cells(i, 1).Value <> ""

    Set NewMail = New CDO.Message

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

    'Make SMTP authentication 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 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") = 465

    NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

    'Set your credentials of your Gmail Account

    NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "shank@gmail.com"

    NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "****"

     'Update the configuration fields
    NewMail.Configuration.Fields.Update

    With NewMail
        StrPath = Cells(i, 2).Value
        .Subject = ""
        ' adds the data in column3 with space as subject
        .From = "shank@gmail.com"

         Text = Cells(i, 1).Value
         StrFile = Dir(StrPath & "*.txt")
         'Text2 = Cells(i, 2).Value

        .To = Text
        .BCC = ""
        .TextBody = "WDAdsas"
        .AddAttachment StrFile
        .Send
    End With
    i = i + 1
Loop

End Sub

我的Excel包含第一列中的电子邮件ID，第二列包含每个附件的地址:( Excel看起来像）

sprasad@p.com   E:\Shank E drive\Gon\EBooks\BBB\
shank@gwu.      E:\Shank E drive\Gon\EBooks\AAA\

当我逐步调试时，我在StrFile中获取了txt文件，但addattachment无法读取它。

它给出了错误，指定的协议是未知的。

Answer 1

StrPath= Column2Range
FileType = "*.txt"

strFile = Dir(StrPath & FileType)
If Len(strFile ) = 0 Then
  GoTo ExitProc
End If
  Do While Len(strFile ) > 0
  .AddAttachment StrPath & strFile 
  strFile = Dir
Loop
ExitProc:

这对你有用。如果你需要帮助来理解它，请告诉我。

Answer 2

请查看以下链接。

http://www.rondebruin.nl/win/s1/outlook/amail6.htm

我认为这会让你朝着正确的方向前进。如果您还有其他问题，请回复。

附加文件夹中的所有文件

2 个答案: