Пакетная отправка факсов с контролем Excel попыток повторной попытки

Question

Я использую CDO для отправки факсов на efax.co.uk. Я отправляю несколько факсов одновременно (возможно, до 10) на один и тот же номер факса. Проблема в том, что efax сообщает, что большинство факсов, которые я отправляю, как неудачные, потому что номер факса занят (угадайте, что, я занят отправкой факсов). Я проверил с помощью efax, невозможно ни настроить время повторной попытки, ни поставить факсы в очередь на один и тот же номер.

Поэтому я хотел бы создать отдельный экземпляр Excel (возможно, с использованием CreateObject("excel.application")), который имеет макрос фоновой пакетной обработки. Этот второй экземпляр мне нужно:

1. обратитесь к листу в первом экземпляре Excel, чтобы получить список факсов для отправки.
2. отправить письмо / факс, снова ссылаясь на информацию в первую очередь.
3. сначала измените цвет ячейки, чтобы показать, что она отправила факс.

Когда я запускаю компьютер и открываю первый экземпляр, я хочу, чтобы он автоматически запускал второй экземпляр. Таким образом, когда я закрываю первый экземпляр, я хотел бы, чтобы он также закрыл второй экземпляр.

Макрос, который я сейчас использую для отправки факсов:

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") = "[e-mail]"
        .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: [e-mail]" & vbNewLine & _
          "W: http://www.xxxxx"


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

With iMsg
    Set .Configuration = iConf
    .To = "[e-mail]"

    .CC = ""
    .BCC = ""
    .From = """Pritchard Property"" <[e-mail]>"
    .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