Question

早上好，我重复使用旧代码，我唯一要改变的是我要附加两个文件。一个是静态的，另一个是宏创建的，每个电子邮件的文件名都会更改。

我踩过我的代码，第二个附件就失败了。我没有错误描述，我无法看到代码出错的地方。

Public Sub EMailCert()

    Dim OutApp As Object
    Dim OutMail As Object

    Dim strAddress As String
    Dim SigString As String
    Dim Signature As String
    Dim TxtString As String
    Dim strBodyTxt As String
    Dim strRecipient As String
    Dim strCertificate As String
    Dim strAttachCert As String
    Dim strEvaluation As String
    Dim strCPDCat As String

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error GoTo Errorcatch

'Your Sheet names need to be correct in here
    Set sh1 = Sheets("Radiology")
    Set sh2 = Sheets("Email")

    r = ActiveCell.Row

'Dear Dr
strAddress = "Dear " & sh1.Cells(r, 6) & vbNewLine & vbNewLine
'Recipient
strRecipient = "This certificate is for " & sh1.Cells(r, 6) & " " & sh1.Cells(r, 7) & vbNewLine
'Signature Christine
Signature = "C:\Users\305015724\AppData\Roaming\Microsoft\Signatures\Christine.txt"
'Certificate Details
strCertificate = "Please find attached your CPD certificate for the GE " & sh1.Cells(r, 1) & " at " & sh1.Cells(r, 2) & "." & vbNewLine & vbNewLine
'Body Text
strBodyTxt = "This Training has been approved for " & sh1.Cells(r, 10) & " CPD points as per Group " & sh1.Cells(r, 18) & " of the 2012 requirements booklet. "
'Evaluation Form
strEvaluation = "Please submit the attached evaluation form with your activity record." & vbNewLine & vbNewLine
'CPD Category
If sh1.Cells(r, 18) = "2.6" Then
    strCPDCat = "CPD points for this group are limited to 2 per year per modality (6 points for a new modality)."
Else
    strCPDCat = ""
End If

'FileName Certificate
Dim YYMM As String
YYMM = Format(sh1.Cells(r, 16).Value, "YYMM")
strAttachCert = "C:\Users\305015724\Documents\ApplicationsTraining\2016\" & YYMM & "_" & sh1.Cells(r, 3).Value & "_" & sh1.Cells(r, 7).Value & ".pdf"

'Send Email
    On Error GoTo cleanup
    With OutMail
        .To = sh1.Cells(r, 13)
        .CC = ""
        .BCC = ""
        .Subject = "CPD Certificate GE Applications Training - " & sh1.Cells(r, 2)
        .Body = strRecipient & vbNewLine & strAddress & strCertificate & strBodyText & strCPDCat & strEvaluation & Signature
        .Attachments.Add sh2.[A4].Value
        .Attachments.Add strAttachCert
        .Display   'or use .Send

        On Error GoTo 0
        Set OutMail = Nothing
    End With

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

Exit Sub

Errorcatch:
MsgBox Err.Description

0:
Set objWord = Nothing

End Sub

我认为添加两个附件的方法是正确的，所以问题必须是strAttachCert。

感谢您的任何指示。

恭奥克兰

Answer 1

我已经复制了两个subs中的r个引用并对它进行了排序。严格来说，我仍然无法遵循逻辑，因为如果光标已经移动，它应该在正确的行中。

但如果它有效，我该与谁争辩？

VBA电子邮件 - 2个附件

1 个答案: