Hiện tốc độ gửi đính kèm file của (1 người xem)

[vba_gpe]

Gửi anh chị trong diễn đàn
Em có tham khảo cách gửi mail tự động, tuy nhiên khi mình đính kèm file dung lượng nhỏ thì không sao (Vài Kb). File dung lượng lớn thì không biết bao lâu mới xong, vậy có cách nào để kiểm tra thời gian hoàn thành việc đính kèm file không?

Option Explicit

'If you have a GMail account then you can try this example to use the GMail smtp server
'The example will send a small text message
'You must change four code lines before you can test the code

'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Full GMail mail address"
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "GMail password"

'Use your own mail address to test the code in this line
'.To = "Mail address receiver"

'Change YourName to the From name you want to use
'.From = """YourName"" <Reply@something.nl>"

'If you get this error : The transport failed to connect to the server
'then try to change the SMTP port from 25 to 465
'Test OK
Sub CDO_Mail_Small_Text_2()
    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/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "ABC@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "PASS"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    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 = "bcd@gmail.com"
        .CC = ""
        .BCC = ""
        .AddAttachment "c:\Demo.xls"
        ' Note: The reply address is not working if you use this Gmail example
        ' It will use your Gmail address automatic. But you can add this line
        ' to change the reply address  .ReplyTo = "Reply@something.nl"
        .From = """YourName"" <Reply@something.nl>"
        .Subject = "Important message"
        .TextBody = strbody
        .Send
    End With
End Sub

Mong mọi người giúp đỡ em.
Trân trọng