0

我使用 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") = "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
4

1 回答 1

0

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
于 2014-10-13T15:31:22.767 回答