Kodların içine cc'ye mail adresi eklemem gerekiyor

[wolfman75]

Sub Send_Row_Or_Rows_Attachment_1()
Dim rng As Range
Dim Ash As Worksheet
Dim Cws As Worksheet
Dim Rcount As Long
Dim Rnum As Long
Dim FilterRange As Range
Dim FieldNum As Integer
Dim mailAddress As String
Dim NewWB As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

On Error GoTo cleanup

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

'Set filter sheet, you can also use Sheets("MySheet")
Set Ash = ActiveSheet

'Set filter range and filter column (column with names)
Set FilterRange = Ash.Range("A17:I" & Ash.Rows.Count)
FieldNum = 1 'Filter column = A because the filter range start in column A

'Add a worksheet for the unique list and copy the unique list in A1
Set Cws = Worksheets.Add
FilterRange.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Cws.Range("A1"), _
CriteriaRange:="", Unique:=True

'Count of the unique values + the header cell
Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))

'If there are unique values start the loop
If Rcount >= 2 Then
For Rnum = 2 To Rcount

'Look for the mail address in the MailInfo worksheet
mailAddress = ""
On Error Resume Next
mailAddress = Application.WorksheetFunction. _
VLookup(Cws.Cells(Rnum, 1).Value, _
Worksheets("Mailinfo").Range("A1:C" & _
Worksheets("Mailinfo").Rows.Count), 2, False)
On Error GoTo 0

If mailAddress <> "" Then

'Filter the FilterRange on the FieldNum column
FilterRange.AutoFilter Field:=FieldNum, _
Criteria1:=Cws.Cells(Rnum, 1).Value

'Copy the visible data in a new workbook
With Ash.AutoFilter.Range

 

[wolfman75]

kodu excelden mail atmak için kullanıyorum excelde yazdığım bir adrese gönderiyor ben kodun içine aynı maili cc olarakta başka birine göndermek istiyorum yardımcı olacak bir arkadaş varsa sevinirim

 

[ockucukay]

Forumda "makroyla mail gönderme" olarak aratın, bir sürü örnek bulacaksınız.

 

[hamitcan]

Aşağıdaki kodu kullanabilirsiniz.

sub mail()
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
    .To = "deneme@deneme.com"
    [color=red].CC = "deneme@deneme.com"[/color]
    .BCC = ""
    .Subject = "deneme"
    '.Body = "a"
    .Attachments.Add ThisWorkbook.Path & "\" & ActiveWorkbook.Name
    '.Send
    .Display
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
    MsgBox "Mail Gönderilmiştir", vbInformation
End Sub