2017-01-25 6 views
0

グッドモーニング、私は古いコードを再利用していると私は変更する唯一のことは、私は2つのファイルを添付したいということです。 1つは静的ですが、もう1つはマクロによって作成され、電子メールごとにファイル名が変更されます。VBAメール - 2つの添付ファイル

私は自分のコードをステップ実行することだし、それは第二の付着に失敗しました。エラーの説明はなく、コードがどこに間違っているのかわかりません。

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 

2つの添付ファイルを追加する方法は正しいと思うので、問題はstrAttachCertである必要があります。

ありがとうございます。

クリスティン オークランド

+0

「のOn Error後藤クリーンアップ」コメントアウト私はこの非エラー処理がエラーを隠すようにエラーが発生したと仮定します。 MailMergeCertがリストに一人一人のために証明書を生成しますが、 EmailCertが同じ人に送信し続ける:私は実際にこの問題を解決した – niton

+0

コードは、私が予期しない結果を得た作品ということになりました(私のフォルダパスは、1つのレベルを逃した)けど。 私はその論理に従うことができるかどうかわかりません。クリスティン –

答えて

0

私は両方の潜水艦のR参照を複製しているし、それはそれをソート。厳密に言えば、カーソルが移動した場合、正しい行になければならないので、私はまだロジックに従うことができません。

しかし、それが動作するかどうか、私は主張するのですか?

関連する問題