利用vba發mail的問題

doom834

各位大大，最近我寫了一個自動發mail的程式，但遇到了2個問題，不知道有沒有人可以幫我解決一下，謝謝。
以下是我的程式碼：
1.這個程式碼有時候會寄不出去，我測試2~3個人時都是正常的，但人數超過20個人以上就容易發生寄不出去
2.outlook 2010時會出現安全性問題，也容易造成mail寄不出去

Sub Auto_SendMail()
On Error Resume Next
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(olMailItem)

    Sheets("Setting Sheet").Select

    Email = ""
    Email_cc = ""
    '確認收件人與副件人員名單是否是空的
    If WorksheetFunction.CountA(Columns(18)) < WorksheetFunction.CountA(Columns(19)) Then
   
        MsgBox "抄送人数不可大于正常收件者人数，请重新确认，谢谢。"
        Set objMail = Nothing
        Set objOutlook = Nothing
        Exit Sub
        
    Else
   
        If WorksheetFunction.CountA(Columns(18)) <= 1 Then
        
            MsgBox "正常收件者人数不得为空，请重新确认，谢谢。"
            Set objMail = Nothing
            Set objOutlook = Nothing
            Exit Sub
        
        End If
   
    End If
   
    For r = 2 To WorksheetFunction.CountA(Columns(18))
   
        Email = Sheets("Setting Sheet").Cells(r, 18) & ";" & Email
        
        If Sheets("Setting Sheet").Cells(r, 19) <> "" Then
        
            Email_cc = Sheets("Setting Sheet").Cells(r, 19) & ";" & Email_cc
        
        End If
        
    Next r
   
'       Compose the message
        Msg = ""
        Msg = Msg & "Dear all," & vbCrLf & vbCrLf
        Msg = Msg & "附件Excel是測試 Data - " & Format(Now(), "YYYY/MM/DD") & " " & Format(Now(), "HH:00(AM/PM)") & "数据。" & vbCrLf & vbCrLf
        Msg = Msg & "数据是从" & Format(Now() - 2, "YYYY/MM/DD") & " 00:00 至 " & Format(Now(), "YYYY/MM/DD") & " " & Format(Now(), "HH:00(AM/PM)") & "（测试时间点）。" & vbCrLf & vbCrLf

        Msg = Msg & "Best Regards!"
        
'       Message subject
        Subj = "test mail!!"

    With objMail
        .To = Email
        .CC = Email_cc
        .Subject = Subj
        .Body = Msg
        .Attachments.Add Save_File_Path & "AAAA_" & Format(Now(), "YYYYMMDD") & "_" & Format(Now(), "HH(AM/PM)") & ".xlsm"
        .Display
        .Send
    End With

Set objMail = Nothing
Set objOutlook = Nothing

End Sub