From feild, CC field needed.. :(

[safi0102]

Hi Guys,

Below is my working code..

i need to add from and CC field in the mailing option...

Can someone help me ?

Thing is taht FROM and CC both will be the same email address.

Your help on this will be much appreciated.

option Explicit

Sub create_sheets()
Dim wb As Workbook
Dim i As Long, lrow As Long
Dim sname As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With Workbooks("Import Subport Tracker From NEW August-2012").Worksheets("Soumendra")
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 2 To lrow
        If .Range("AA" & i).Value <> "PRO" Then
            sname = .Range("D" & i).Value
            Workbooks.Add
            Set wb = ActiveWorkbook
            ThisWorkbook.Worksheets("Sheet1").Cells.Copy wb.Worksheets(1).Range("A1")
            wb.Worksheets(1).Range("B22").Value = .Range("B" & i).Value
            wb.Worksheets(1).Range("D5").Value = sname
            wb.Worksheets(1).Range("D7").Value = .Range("F" & i).Value
            wb.Worksheets(1).Range("B2").Value = .Range("AA" & i).Value
            wb.Worksheets(1).Range("C30").Value = .Range("H" & i).Value
            wb.Worksheets(1).Range("G27").Value = .Range("I" & i).Value
            wb.Worksheets(1).Range("B14").Value = .Range("j" & i).Value
            wb.Worksheets(1).Range("B18").Value = .Range("K" & i).Value
            wb.Worksheets(1).Range("L12").Value = .Range("G" & i).Value
            wb.Worksheets(1).Range("A6").Value = Format(Now(), "dd/mm/yyyy")
            wb.Worksheets(1).Range("A7").Value = Format(Now(), "H:MM")
            
            With wb.Worksheets(1)
                If .Range("B14").Value = "OPAL" Then
                    .Range("H14").Value = "820"
                ElseIf .Range("B14").Value = "BT" Then
                    .Range("H14").Value = "001"
                ElseIf .Range("B14").Value = "SKY" Then
                    .Range("H14").Value = "822"
                ElseIf .Range("B14").Value = "TELEWEST" Then
                    .Range("H14").Value = "135"
                ElseIf .Range("B14").Value = "NTL" Then
                    .Range("H14").Value = "825"
                End If
                
                If .Range("B18").Value = "OPAL" Then
                    .Range("H18").Value = "820"
                ElseIf .Range("B18").Value = "BT" Then
                    .Range("H18").Value = "001"
                ElseIf .Range("B18").Value = "SKY" Then
                    .Range("H18").Value = "822"
                ElseIf .Range("B18").Value = "TELEWEST" Then
                    .Range("H18").Value = "135"
                ElseIf .Range("B18").Value = "NTL" Then
                    .Range("H18").Value = "825"
                End If
            End With
            
            If Dir("T:\SGD Z Drive\CW Access Provisioning\Porting Desk\GNP Tesco Import\2013 Tesco\Safi\" & sname & "\") = "" Then
                MkDir ("T:\SGD Z Drive\CW Access Provisioning\Porting Desk\GNP Tesco Import\2013 Tesco\Safi\" & sname & "\")
            End If
             
            wb.SaveAs ("T:\SGD Z Drive\CW Access Provisioning\Porting Desk\GNP Tesco Import\2013 Tesco\Safi\" & sname & "\" & sname & "_RH.xls")
        
RunThisOnError:
       
            Dim iTryAgain  As Integer
            iTryAgain = iTryAgain + 1
            If iTryAgain = 250 Then GoTo GiveUpOnTheEmail
    
          
            If Val(Application.Version) >= 12 Then
                If wb.FileFormat = 51 And wb.HasVBProject = True Then
                    GoTo GiveUpOnTheEmail
                End If
            End If
    
            On Error Resume Next
            Dim iLoop As Integer
            For iLoop = 1 To 3
            
            With wb.Worksheets(1)
            
                If .Range("B18").Value = "OPAL" Then
                        wb.SendMail ("gnp@cw.com"), ("CW_Ports_" & sname & "_RH")
        
                ElseIf .Range("B18").Value = "BT" Then
                        wb.SendMail ("gnp@cw.com"), ("CW_Single_" & sname & "_RH")
        
                ElseIf .Range("B18").Value = "SKY" Then
                        wb.SendMail ("gnp@cw.com"), ("CW_Single_" & sname & "_RH")
        
                ElseIf .Range("B18").Value = "TELEWEST" Then
                        wb.SendMail ("gnp@cw.com"), ("CW_Single_" & sname & "_RH")
        
                ElseIf .Range("B18").Value = "NTL" Then
                        wb.SendMail ("gnp@cw.com"), ("CW_Single_" & sname & "_RH")
        
                End If
                                     
            End With
                 If Err.Number = 0 Then Exit For
            Next iLoop
    
            On Error GoTo RunThisOnError
GiveUpOnTheEmail:
    
            wb.Close
        End If
    Next i
End With

MsgBox "Done"

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

TIA
Safi

[safi0102]

HI Guys,

I have used Array for CC field...

But can some one help me to get a code for : SENDING TEH MAIL ON BEHALF OF ?

Thanks,
Safi.

[safi0102]

Guys ,

Can some one assist me ??? :'(

Thanks,
Safi.

[arlu1201]

Since you have already solved this question yourself and asked the question regarding "sending email on behalf of another" in another thread, i will mark this as solved.