简体   繁体   中英

VBA - send email from secondary inbox

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

for anyone who may need it in the future i found the solution by integrating the below into my script: How to send email from a specific Outlook account using Excel?

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM