i have a script sending a worksheet to a user but i need to set the "sent" email to my secondary inbox.
i've tried the .sender context which is part of the mailitem code but it doesn't change anything.
i have access to the requested inbox so it's not that.
can anyone point me in the right direction please
Sub Send_email_fromtemplate(CardEmail, StaffName As String)
Dim edress As String
Dim subj, name As String
Dim filename As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim myAttachments As Object
Dim path As String
Dim attachment As String
Dim r As Long
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim customername As String
Dim EmailApp As Outlook.Application
Dim app_Outlook As Object
Set app_Outlook = CreateObject("Outlook.Application")
Dim objEmail As MailItem
Set objEmail = app_Outlook.CreateItem(olMailItem)
Dim EmailItem As Outlook.MailItem
Dim Destwb As Workbook
Dim Sourcewb As Workbook
Dim sEmailFrom As String
r = 2
Set Sourcewb = ActiveWorkbook
sEmail_From = Sourcewb.Sheets("table1").Cells(1, 11)
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
Select Case ThisWorkbook.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.name & " " & Format(Now, "mmm-yy")
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
End With
'Do While Sheet1.Cells(r, 1) <> ""
Set outlookapp = CreateObject("Outlook.Application")
'call your template
Set outlookmailitem = outlookapp.CreateItemFromTemplate("C:\Users\user\CCStatement.oft")
'Set myAttachments = Destwb.FullName
'deifine your path for the attachment
path = "C:\Users\user"
edress = CardEmail
name = ActiveSheet.name
subj = "Corporate Credit Card Statement for the period ended " & Sourcewb.Sheets("Table1").Cells(1, 6) & "- **To be completed & returned by " & Sourcewb.Sheets("Table1").Cells(1, 9) & " **"
filename = Sheet1.Cells(r, 4)
attachment = Destwb.FullName
objEmail.SentOnBehalfOfName = sEmail_From
outlookmailitem.Display
With outlookmailitem
'.To = edress
.To = "useremail"
**.Sender = "senderemail"**
.CC = ""
.BCC = ""
.Subject = subj
.Attachments.Add Destwb.FullName
objEmail.SentOnBehalfOfName = sEmailFrom
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(FindText:="xxxxx")
oRng.Text = name
Exit Do
Loop
End With
Set xInspect = outlookmailitem.GetInspector
.Display
.Send
End With
With Destwb
.Close
Kill TempFilePath & TempFileName & FileExtStr
End With
'clear your email address
edress = ""
r = r + 1
'Loop
'clear your fields
Set outlookapp = Nothing
Set outlookmailitem = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
End Sub
