Help with Macro "Need to have macro working with send on behalf of name"

jgarciaf106

New Member
Joined
Mar 16, 2017
Messages
3
Need help to update the code below, so I can send emails on behalf of, instead from my account. I do use ms Exchange.
I am new and currently learning macros all help is appreciated.

HTML:
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                         ByVal hwnd As LongPtr, ByVal lpOperation As String, _
                         ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
                         ByVal nShowCmd As Long) As LongPtr
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                         ByVal hwnd As Long, ByVal lpOperation As String, _
                         ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
                         ByVal nShowCmd As Long) As Long
#End If
Sub SendAwaitingActions()
'update by Extendoffice 20160506
    Dim xEmail As String
    Dim xSubj As String
    Dim xMsg As String
    Dim xURL As String
    Dim i As Integer
    Dim k As Double
    Dim xCell As Range
    Dim xRg As Range
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the data range:", "Awaiting Actions Tool by ag732312", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count <> 11 Then
        MsgBox " Regional format error, please check", , "Awaiting Actions Tool by ag732312"
        Exit Sub
    End If
    For i = 1 To xRg.Rows.Count
'       Get the email address
        xEmail = xRg.Cells(i, 11)
'       Message subject
        xSubj = "Workday Awaiting Actions " & xRg.Cells(i, 10) & "." & vbCrLf & vbCrLf
'       Compose the message
        xMsg = ""
        xMsg = xMsg & "Dear " & xRg.Cells(i, 10) & "," & vbCrLf & vbCrLf
        xMsg = xMsg & "Hope you are well, I would appreciate if you can help us approving the following process on Workday, if needed let me know to rescind the process." & "." & vbCrLf & vbCrLf
        xMsg = xMsg & "Awaiting Person: " & xRg.Cells(i, 10).Text & "." & vbCrLf & vbCrLf
        xMsg = xMsg & "Employee ID: " & xRg.Cells(i, 1).Text & "." & vbCrLf & vbCrLf
        xMsg = xMsg & "Worker: " & xRg.Cells(i, 2).Text & "." & vbCrLf & vbCrLf
        xMsg = xMsg & "Country: " & xRg.Cells(i, 3).Text & "." & vbCrLf & vbCrLf
        xMsg = xMsg & "Business Process: " & xRg.Cells(i, 4).Text & "." & vbCrLf & vbCrLf
        xMsg = xMsg & "Business Process Transaction: " & xRg.Cells(i, 5).Text & "." & vbCrLf & vbCrLf
        xMsg = xMsg & "Date and Time Initiated: " & xRg.Cells(i, 6).Text & "." & vbCrLf & vbCrLf
        xMsg = xMsg & "Status: " & xRg.Cells(i, 7).Text & "." & vbCrLf & vbCrLf
        xMsg = xMsg & "Reason: " & xRg.Cells(i, 8).Text & "." & vbCrLf & vbCrLf
        xMsg = xMsg & "Business Process Step or To Do Awaiting Action (Includes Subprocesses): " & xRg.Cells(i, 9).Text & "." & vbCrLf & vbCrLf
        xMsg = xMsg & "Do not hesitate in contacting us if you need additional support. " & vbCrLf
        xMsg = xMsg & "test Latam: test@test.com"
'       Replace spaces with %20 (hex)
        xSubj = Application.WorksheetFunction.Substitute(xSubj, " ", "%20")
        xMsg = Application.WorksheetFunction.Substitute(xMsg, " ", "%20")
'       Replace carriage returns with %0D%0A (hex)
        xMsg = Application.WorksheetFunction.Substitute(xMsg, vbCrLf, "%0D%0A")
'       Create the URL
        xURL = "mailto:" & xEmail & "?subject=" & xSubj & "&body=" & xMsg
'       Execute the URL (start the email client)
        ShellExecute 0&, vbNullString, xURL, vbNullString, vbNullString, vbNormalFocus
'       Wait two seconds before sending keystrokes
        Application.Wait (Now + TimeValue("0:00:02"))
        Application.SendKeys "%s"
    Next
End Sub
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Forum statistics

Threads
1,216,075
Messages
6,128,660
Members
449,462
Latest member
Chislobog

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top