Question

我使用CDO将传真通过电子邮件发送到efax.co.uk.我一次发送多个传真（可能最多10个）到同一传真号码。问题是efax报告我发送的大部分传真都不成功，因为传真号码很忙（猜猜是什么，忙于发送我的传真）。我用efax检查过，不能配置重试时间，也不能将传真排队到相同的号码。

因此，我想创建一个单独的Excel实例（可能使用CreateObject（“excel.application”）），它具有后台批处理宏。我需要的第二个例子是：

引用Excel第一个实例中的工作表，以获取要发送的传真列表。
发送电子邮件/传真，再次引用第一个实例中的信息。
在第一个实例中更改单元格的颜色以显示它已发送传真。

当我启动计算机并打开第一个实例时，我希望它能自动启动第二个实例。因此，当我关闭第一个实例时，我希望它也关闭第二个实例。

我目前用来发送传真的宏：

Sub faxTPD()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant

vuser = Environ("USERNAME")
vweek = Format(range("ThisWeek"), "yymmdd")
vtenant = range("tblaccounts").ListObject.ListColumns("Name").DataBodyRange(range("statementrow"))
Application.StatusBar = "FAX TPD: " & vtenant

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/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxx@yahoo.co.uk"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxx"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.yahoo.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Update
    End With

strbody = "Hello Third Party Deduction Team," & vbNewLine & vbNewLine & _
          "Please find following Third Party Deduction Application and Rent Schedule for welfare benefit tenant " & vtenant & "." & vbNewLine & vbNewLine & _
          "Regards" & vbNewLine & _
          "Pritchard Property" & vbNewLine & _
          "T: xxxxxxx" & vbNewLine & _
          "E: xxxxxxxx@yahoo.co.uk" & vbNewLine & _
          "W: http://www.xxxxx"


vpath = "C:\Users\" & vuser & "\Google Drive\WR Tenant Statements\DWP\" & vweek

With iMsg
    Set .Configuration = iConf
    .To = "441978xxxxxx@efaxsend.com"

    .CC = ""
    .BCC = ""
    .From = """Pritchard Property"" <xxxxxxx@yahoo.co.uk>"
    .Subject = "Third Party Deduction Application for Welfare Benefit Tenant " & vtenant
    .TextBody = strbody
    .addattachment vpath & "\" & vtenant & " DWP TPD.pdf"                                                           ' DWP TPD request arrears payment £3.65
    .addattachment vpath & "\" & vtenant & " Rent Schedule.pdf"                                                     ' Rent Schedule

    If range("tblaccounts").ListObject.ListColumns("AST").DataBodyRange(range("statementrow")) <> "" Then
        .addattachment range("tblaccounts").ListObject.ListColumns("AST").DataBodyRange(range("statementrow"))          ' AST
    End If

    If range("tblaccounts").ListObject.ListColumns("DWP TPD").DataBodyRange(range("statementrow")) <> "" Then
        .addattachment range("tblaccounts").ListObject.ListColumns("DWP TPD").DataBodyRange(range("statementrow"))      ' DWP TPD permission
    End If

    .Send
End With

End Sub

Answer 1

Applcation.OnTime可能是去这里的方式。您可以安排程序在将来的某个时间运行。在此期间，Excel正常工作，用户可以继续工作。如果您希望每五分钟发送一次传真，直到您全部发送传真，它可能看起来像这样

'Create variables that don't lose scope until the workbook is closed
Public gvaTenants As Variant
Public glTenant As Long

Sub StartFaxes()

    'put all the tenants in an 2d array
    gvaTenants = Sheet1.ListObjects(1).ListColumns("name").DataBodyRange.Value
    'start with the first tentant
    glTenant = 1

    SendOneFax

End Sub

Sub SendOneFax()

    Dim sBody As String

    'Send the first fax
    '   Some CDO setup stuff
    sBody = "Dear " & gvaTenants(glTenant, 1) & ":" & vbNewLine & "Rest of message"
    '   Finish up CDO stuff and send

    'increment to the next tenant
    glTenant = glTenant + 1

    'if we haven't sent the last one, schedule VBA to run this code
    'again in five minutes
    If glTenant <= UBound(gvaTenants, 1) Then
        Application.OnTime Now + TimeSerial(0, 5, 0), "SendOneFax"
    End If

    'During the five minutes between runs, the user can Excel normally.
    'the next time it runs, the user will have to wait a few secs for it to finish

End Sub

使用Excel控制重试尝试的批量传真

1 个答案: