Using Sendkeys to Email

G

Gman

New member
Joined
Jul 5, 2014
Messages
2
Reaction score
0
Points
0
Hi,

I posted my problem to another forum a few days ago without any replys.

I have code to send email from excel opening outlook to accomplish. Recently on my job computers were updated with Windows 7 and Excel 2010. Because of security patches the code non longer works. I would like assistance to modify the code to use sendkeys to perform the task. Please see the following code:

Code: 
Sub SendMail(guide As String) '''Updates next list and sends email

    Dim UserName As String, UserEmail As String, Keeper As String
    Dim NextName As String, NextEmail As String
    Dim NextRow As Integer, xRow As Integer
    Dim KeeperMail As Boolean, Openguide As Boolean


On Error GoTo 1
    
    Dim OlApp As New Outlook.Application
    Dim myNameSp As Outlook.Namespace
    Dim myInbox As Outlook.MAPIFolder
    Dim myExplorer As Outlook.Explorer
    Dim NewMail As Outlook.MailItem
    Dim OutOpen As Boolean

'''More code is placed here

    ' Check to see if there's an explorer window open
    ' If not then open up a new one
    OutOpen = True
    Set myExplorer = OlApp.ActiveExplorer
    If TypeName(myExplorer) = "Nothing" Then
        OutOpen = False
        Set myNameSp = OlApp.GetNamespace("MAPI")
        Set myInbox = myNameSp.GetDefaultFolder(olFolderInbox)
        Set myExplorer = myInbox.GetExplorer
    End If
    ' Create a new mail message item.
    Set NewMail = OlApp.CreateItem(olMailItem)  
    If OpenWatch = False Then
        NewMail.Body = Worksheets("Main").Cells(NextRow, 1).Value + " " + NextName _
                    + "," + vbCrLf + "It is your turn to update the " + guide + " guidelist." _
                    + vbCrLf + "<<" + Worksheets("Rot").Cells(17, 2).Value + ActiveWorkbook.Name _
                    + ">>" + vbCrLf + vbCrLf + "V/R" + vbCrLf + Worksheets("Main").Cells(UserRow(), 1).Value _
                    + " " + UserName
    Else
        NewMail.Body = guide + "s:" + vbCrLf + "The " + guide + " guidelist is open for all to fill." _
                    + vbCrLf + "<<" + Worksheets("Rot").Cells(17, 2).Value + ActiveWorkbook.Name _
                    + ">>" + vbCrLf + vbCrLf + "V/R" + vbCrLf + Worksheets("Main").Cells(UserRow(), 1).Value _
                    + " " + UserName
    End If

    With NewMail
        .Subject = "Automated guidelist Response"
        .To = NextEmail
        .CC = Keeper
        .Send
    End With
    
    If Not OutOpen Then OlApp.Quit

    'Release memory.
    Set OlApp = Nothing
    Set myNameSp = Nothing
    Set myInbox = Nothing
    Set myExplorer = Nothing
    Set NewMail = Nothing
    
    
2:  '''Jumps here if next was blank so no need to re-email everyone.
    SaveFile  '''saves file

    If KeeperMail = False Then CloseFile

1:   '''Jumps here if they did not allow email to send.  Returning to main screen.

End Sub

I would really appreciate if someone on this forum could point me in the right direction.

Thank you in advance.
 
You could try this, although the variable OpenWatch doesn't seem to be defined or setup.

Code: 
Sub SendMail(guide As String) '''Updates next list and sends email

    Dim UserName As String, UserEmail As String, Keeper As String
    Dim NextName As String, NextEmail As String
    Dim NextRow As Integer, xRow As Integer
    Dim KeeperMail As Boolean, Openguide As Boolean


On Error GoTo 1
    
    Dim OlApp As Object
    Dim myNameSp As Object
    Dim myInbox As Object
    Dim myExplorer As Object
    Dim NewMail As Object
    Dim OutOpen As Boolean
    
    Set OlApp = CreateObject("Outlook.Application")


'''More code is placed here


    ' Check to see if there's an explorer window open
    ' If not then open up a new one
    OutOpen = True
    Set myExplorer = OlApp.ActiveExplorer
    If TypeName(myExplorer) = "Nothing" Then
        OutOpen = False
        Set myNameSp = OlApp.GetNamespace("MAPI")
        Set myInbox = myNameSp.GetDefaultFolder(6) 'olFolderInbox
        Set myExplorer = myInbox.GetExplorer
    End If
    ' Create a new mail message item.
    Set NewMail = OlApp.CreateItem(0) 'olMailItem
    If OpenWatch = False Then
        NewMail.Body = Worksheets("Main").Cells(NextRow, 1).Value + " " + NextName _
                    + "," + vbCrLf + "It is your turn to update the " + guide + " guidelist." _
                    + vbCrLf + "<<" + Worksheets("Rot").Cells(17, 2).Value + ActiveWorkbook.Name _
                    + ">>" + vbCrLf + vbCrLf + "V/R" + vbCrLf + Worksheets("Main").Cells(UserRow(), 1).Value _
                    + " " + UserName
    Else
        NewMail.Body = guide + "s:" + vbCrLf + "The " + guide + " guidelist is open for all to fill." _
                    + vbCrLf + "<<" + Worksheets("Rot").Cells(17, 2).Value + ActiveWorkbook.Name _
                    + ">>" + vbCrLf + vbCrLf + "V/R" + vbCrLf + Worksheets("Main").Cells(UserRow(), 1).Value _
                    + " " + UserName
    End If


    With NewMail
        .Subject = "Automated guidelist Response"
        .To = NextEmail
        .CC = Keeper
        .Send
    End With
    
    If Not OutOpen Then OlApp.Quit


    'Release memory.
    Set OlApp = Nothing
    Set myNameSp = Nothing
    Set myInbox = Nothing
    Set myExplorer = Nothing
    Set NewMail = Nothing
    
    
2:  '''Jumps here if next was blank so no need to re-email everyone.
    SaveFile  '''saves file


    If KeeperMail = False Then CloseFile


1:   '''Jumps here if they did not allow email to send.  Returning to main screen.


End Sub
 
Thanks for your reply BOB. I'll try it first thing in the morning. Yes OpenWatch should have been OpenGuide.
 
You must log in or register to reply here.
Back
Top