Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88075

How to add If condition?

$
0
0

I've created a program to create and send receipts. I managed this by looking online.

It works, but I'd like send the receipts when a condition is met.

cfws.Range("N"& I).Value = "no"

Do I start the If after I create the pdf files or after creating the Outlook object?

I tried several things but on most of my attempts, I get an error

Next without For.

Option Explicit

Sub CopyToTemplate()

Dim cfws As Worksheet
Dim ctws As Worksheet
Dim lastrow As Long
Dim I As Long
Dim fileloc As String
Dim filename As String
Dim Fname As String
Dim OutlApp As Object
Dim IsCreated As Boolean
Dim Count As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set cfws = Worksheets("Monthly data")
Set ctws = Worksheets("Template")

Count = 0

lastrow = cfws.Cells(cfws.Rows.Count, "B").End(xlUp).Row
fileloc = "C:\Users\dave.i\Documents\Project\Receipts\"'This creates the receipt
For I = 2 To lastrow
    filename = "DCN #"& cfws.Range("A"& I).Value & " receipt"
    ctws.Range("C41").Value = "Sub ID "& cfws.Range("A"& I).Value
    ctws.Range("D14").Value = cfws.Range("B"& I).Value
    ctws.Range("C43").Value = cfws.Range("B"& I).Value
    ctws.Range("D13").Value = cfws.Range("C"& I).Value
    ctws.Range("C42").Value = cfws.Range("C"& I).Value
    ctws.Range("C44").Value = cfws.Range("D"& I).Value
    ctws.Range("C45").Value = cfws.Range("E"& I).Value
    ctws.Range("D15").Value = cfws.Range("D"& I).Value & ", "& cfws.Range("E"& I).Value
    ctws.Range("I45").Value = cfws.Range("F"& I).Value
    ctws.Range("I46").Value = cfws.Range("G"& I).Value
    ctws.Range("I47").Value = cfws.Range("H"& I).Value
    ctws.Range("C45").Value = cfws.Range("E"& I).Value
    ctws.Range("B51").Value = cfws.Range("I"& I).Value
    ctws.Range("H50").Value = cfws.Range("J"& I).Value
    ctws.Range("B56").Value = "Charged to "& cfws.Range("K"& I).Value & " on"
    ctws.Range("B57").Value = cfws.Range("L"& I).Value

'This names the receipt and creates it
    Fname = fileloc & filename & ".pdf"
    With ctws
        .ExportAsFixedFormat Type:=xlTypePDF, filename:=Fname
    End With

'Time to send the receipts
' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0


**'Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)

    ' Prepare e-mail
    .Subject = "Daily Commercial News receipt #"& cfws.Range("A"& I).Value
    .To = cfws.Range("M"& I).Value
    '.CC = "..."'<-- Put email of 'copy to' recipient here
    .Body = "Hello,"& vbLf & vbLf _
          & "Attached is the receipt for your monthly subscription."& vbLf & vbLf _
          & "Please do note hesitate to contact us should you have any other concerns."& vbLf & vbLf _
          & "Best Regards,"& vbLf _
          & Application.UserName & vbLf _
          & "Customer Service representative"& vbLf _
          & vbLf & vbLf
    .Attachments.Add Fname

    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail to "& cfws.Range("M"& I).Value & " was not sent", vbExclamation
    Else
      Count = Count + 1
    End If
    On Error GoTo 0**

End With

Next I

'Sends the number of emails sent
MsgBox Count & " E-mails successfully sent", vbInformation

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Viewing all articles
Browse latest Browse all 88075

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>