BCC from a specific column

Kmahraz · Sep 11, 2015

Hello,
Looking for someone to help with the code below, trying to BCC a list of email in column (J).
Regards,
K

Code:

Sub EmailReport()
Dim OutApp As Object
Dim OutMail As Object

'Use presence of a Path to determine if a mail is sent.
    Set Rng = Range(Range("I2"), Range("I" & Rows.Count).End(xlUp))
    For Each cell In Rng
           
    Path = cell.Value
    If Path <> "" Then
     
'Get Date info from Path
     Dte = Right(Path, Len(Path) - InStrRev(Path, "\"))
     
'Get WHOTO to check for filename (Column A)
     FilNmeStr = cell.Offset(0, -8).Value
'Email Address
     ToName = cell.Offset(0, -5).Value

     'Create Recipient List
    RecpList = ""
    For x = 1 To 4
        Recp = cell.Offset(0, -x).Value
    If Recp <> "" Then
        Recp = cell.Offset(0, -x).Value
    End If

        RecpList = RecpList & ";" & Recp
    Next
     
      ccTo = RecpList
     
     'Get  Name
     FirstNme = cell.Offset(0, -7).Value
     Surname = cell.Offset(0, -6).Value
         
'Loop through files in Path to see if
     ClientFile = Dir(Path & "\*.*")

     Do While ClientFile <> ""

     If InStr(ClientFile, FilNmeStr) > 0 Then

     AttachFile = Path & "\" & ClientFile

     MailBody = "Dear " & FirstNme & vbNewLine & vbNewLine _
     & "Please find attached a copy of your DOP report for " & Dte _
     & vbNewLine & vbNewLine _
     & "WHOTO: " & cell.Offset(0, -8).Value _
     & vbNewLine & _
     "Distributor Principal: " & FirstNme & " " & Surname _
     & vbNewLine & _
     "With thanks" & _
      Signature
           

   Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(o)
        With OutMail
            .Subject = "DOP Report for - " & Dte
            .To = ToName
            .cc = ccTo
            .Body = MailBody
            .Attachments.Add (AttachFile)
            .Display
            '.Send
           
    End With

        Set OutMail = Nothing
        Set OutApp = Nothing
        RecpList = ""
       
End If
ClientFile = Dir
Loop
End If
Next

End Sub

Deepak · Sep 11, 2015

Check this...

I have also revised the code as our previous conversation.

Code:

Sub EmailReport1()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim MailBody As String

'Use presence of a Path to determine if a mail is sent.
   Set Rng = Range(Range("I2"), Range("I" & Rows.Count).End(xlUp))
    For Each cell In Rng
        Path = cell.Value
    If Not Path <> "" Then GoTo n
     
'Get Date info from Path
    Dte = Right(Path, Len(Path) - InStrRev(Path, "\"))
     
'Get WHOTO to check for filename (Column A)
    FilNmeStr = cell.Offset(0, -8).Value
'Email Address
    ToName = cell.Offset(0, -5).Value

     'Create Recipient List
    For x = 1 To 4
        If cell.Offset(0, -x).Value <> "" Then RecpList = RecpList & ";" & cell.Offset(0, -x).Value
    Next
     
      ccTo = Mid(RecpList, 2)
     
     'Get  Name
    FirstNme = cell.Offset(0, -7).Value
     Surname = cell.Offset(0, -6).Value
         
'Loop through files in Path to see if
    ClientFile = Dir(Path & "\" & FilNmeStr & "*.*")
    If Not Len(Dir$(Path & "\" & ClientFile)) > 0 Then GoTo n

         MailBody = "Dear " & FirstNme & vbNewLine & vbNewLine _
         & "Please find attached a copy of your DOP report for " & Dte _
         & vbNewLine & vbNewLine _
         & "WHOTO: " & cell.Offset(0, -8).Value _
         & vbNewLine & _
         "Distributor Principal: " & FirstNme & " " & Surname _
         & vbNewLine & _
         "With thanks" & _
          Signature
               
   
        With CreateObject("Outlook.Application").CreateItem(0)
                .Subject = "DOP Report for - " & Dte
                .To = ToName
                .cc = ccTo
                .bcc = cell.Offset(, 1).Text
                .Body = MailBody
                Do While ClientFile <> ""
                   .Attachments.Add (Path & "\" & ClientFile)
                    ClientFile = Dir
                Loop
                .Display
                '.Send
        End With
        RecpList = ""
   
n: Next

End Sub

Kmahraz · Sep 11, 2015

Hello DeepPak,
The code work great, but it does generate email even if it doesn't find the file in the folder destination.
I would like to send emails only when it find corresponding attachments in the folder.
Regards,
Karim

Deepak · Sep 11, 2015

If doesn't generating email that how works great.
I have tested with relevant path &find working. Tomorrow i will recheck for loop holes.

Kmahraz · Sep 11, 2015

Thank you so much!
It does generate emails even if it doesn't find the file, I would like it to not send an email to my distributors if the attachment is not in the folder destination.
Regards,
Karim

Deepak · Sep 11, 2015

Strange as i have also taken care of the same.

Kmahraz · Sep 11, 2015

As you can see it does generate emails, even if there are no file in the destination folder.
Regards,
Karim

Deepak · Sep 11, 2015

Ok...
Seems also issue with BCC.
I WILL CHECK TOMORROW

Kmahraz · Sep 11, 2015

Thank you so much!
Regards
Karim

Kmahraz · Sep 11, 2015

Dear DeePak,
Just wanted to let you know that the BCC works fine.
The only thing i would like your help with is figuring out why emails are generated even if there's no documents in the destination folder.
Regards,
K

Deepak · Sep 12, 2015

Hi,

This line was wrongly written..
If Not Len(Dir$(Path & "\" & ClientFile)) > 0 ThenGoTo n

Check this..

Code:

Sub EmailReport2()
Dim OutApp As Object, OutMail As Object, cell As Range
Dim MailBody As String, Path As String

'Use presence of a Path to determine if a mail is sent.
  Set Rng = Range(Range("I2"), Range("I" & Rows.Count).End(xlUp))
    For Each cell In Rng
        Path = cell.Value & "\":    If Not Path <> "" Then GoTo n
   
'Get Date info from Path
    Dte = Right(Path, Len(Path) - InStrRev(Path, "\"))
   
'Get WHOTO to check for filename (Column A)
    FilNmeStr$ = cell.Offset(0, -8).Value: ClientFile$ = Dir(Path & FilNmeStr & "*.*")
    If Not Len(ClientFile$) > 0 Then GoTo n

'Email Address
    ToName$ = cell.Offset(0, -5).Value

    'Create Recipient List
    For x = 1 To 4
        If cell.Offset(0, -x).Value <> "" Then RecpList = RecpList & ";" & cell.Offset(0, -x).Value
    Next
    ccTo = Mid(RecpList, 2)
   
    'Get  Name
    FirstNme$ = cell.Offset(0, -7).Value:    Surname$ = cell.Offset(0, -6).Value
       
'Loop through files in Path to see if

        MailBody = "Dear " & FirstNme$ & vbNewLine & vbNewLine _
        & "Please find attached a copy of your DOP report for " & Dte _
        & vbNewLine & vbNewLine _
        & "WHOTO: " & FilNmeStr$ _
        & vbNewLine & _
        "Distributor Principal: " & FirstNme & " " & Surname _
        & vbNewLine & _
        "With thanks" & _
          Signature
             
        With CreateObject("Outlook.Application").CreateItem(0)
                .Subject = "DOP Report for - " & Dte
                .To = ToName: .cc = ccTo: .bcc = cell.Offset(, 1).Text: .Body = MailBody
                Do While ClientFile <> "": .Attachments.Add (Path & ClientFile): ClientFile = Dir: Loop
                .Display
                '.Send
        End With
        RecpList = ""
   
n: Next

End Sub

Kmahraz · Sep 14, 2015

Hello Deepak
The changes worked perfectly, thank you so much for your help and assistance.
Greatly appreciated.
Regards,
K

Kmahraz · Sep 14, 2015

Hello Deepak,
can you please verify one item for me, the codes below are for the email body and subject, and i believe the date need to be inserted automatically based on the folder name, in this case it's not happening can you please let me know what change i should make to make it happen.

Code:

 & "Please find attached a copy of your DOP report for " & Dte _
.Subject = "DOP Report for - " & Dte

Regards,
K

Deepak · Sep 14, 2015

Your date is based on

Dte = Right(Path, Len(Path) - InStrRev(Path, "\"))

So, whats ur Path (Columns I)

Kmahraz · Sep 14, 2015

Yes the Path is columns I
Regards,
K

Deepak · Sep 14, 2015

Paste some of the them here!

Kmahraz · Sep 14, 2015

C:\Users\kmahraz\Desktop\May 2013

Thanks, also attached is the entire file.
please let me know if you need any additional information.
Best,
K

Kmahraz · Sep 14, 2015

hello Deepak,
Here's the change i made and it work.

Code:

StrPath = cell.Value
'Get Date info from Path
   Dte = Right(StrPath, Len(StrPath) - InStrRev(StrPath, "\"))

Regards,
K

Deepak · Sep 14, 2015

U may also check it...

Code:

'Use presence of a Path to determine if a mail is sent.
 Set Rng = Range(Range("I2"), Range("I" & Rows.Count).End(xlUp))

    For Each cell In Rng
        Path = cell.Value:    If Not Path <> "" Then GoTo n
   
'Get Date info from Path
   Dte = Mid(Path, InStrRev(Path, "\") + 1)
    Path = Path & "\"

BCC from a specific column

Kmahraz

Member

Deepak

Excel Ninja

Kmahraz

Member

Deepak

Excel Ninja

Kmahraz

Member

Deepak

Excel Ninja

Kmahraz

Member

Deepak

Excel Ninja

Kmahraz

Member

Kmahraz

Member

Deepak

Excel Ninja

Kmahraz

Member

Kmahraz

Member

Deepak

Excel Ninja

Kmahraz

Member

Deepak

Excel Ninja

Kmahraz

Member

Attachments

Kmahraz

Member

Deepak

Excel Ninja