Connect Outlook to Phone Text Message

Steps to set-up code. (Please also set-up Rule too as shown in Rule section which shows inbox folder and inbox sub-folder set-ups too.

Sub textmyEmailtomyPhone()
Dim individualItem As Object
Dim att As Attachment
Dim strPath As String
Dim dicFileNames As Object


goku = 1

Do Until goku > 25000000
goku = goku + 1
Loop


'Count emails in box
Dim O As Double
For N = 1 To Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) _
    .Items.Count
    ' counts the amount of emails
Next N
N = N - 1

goku = 1

line10:



'Select only recent email
On Error GoTo line10: ActiveExplorer.AddToSelection.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items(N)




Dim myOlExp As Outlook.Explorer
 Dim myOlSel As Outlook.Selection
 Dim mySender As Outlook.AddressEntry
 Dim oMail As Outlook.MailItem
 Dim oAppt As Outlook.AppointmentItem
 Dim oPA As Outlook.PropertyAccessor
 Dim strSenderID As String
 Const PR_SENT_REPRESENTING_ENTRYID As String = _
 "http://schemas.microsoft.com/mapi/proptag/0x00410102"
 Dim MsgTxt As String
 Dim x As Long
 'Get senders of selected emails
 
 Set myOlExp = Application.ActiveExplorer
 Set myOlSel = myOlExp.Selection
 For x = 1 To myOlSel.Count
 If myOlSel.Item(x).Class = OlObjectClass.olMail Then
 ' For mail item, use the SenderName property.
 Set oMail = myOlSel.Item(x)
 MsgTxt = oMail.Body
 End If
 Next


Dim myMessage As MailItem
Set myMessage = Application.CreateItem(ItemType:=olMailItem)
With myMessage
    .To = "INSERTCELLPHONEHERE@messaging.sprintpcs.com"
    .Body = MsgTxt
    .Send
End With

End Sub

Private Sub Application_NewMail()

Dim N As Long
For N = 1 To Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) _
    .Folders("Inbox subfolder").Items.Count
    ' counts the amount of emails
Next N


Dim olnamespace As Outlook.NameSpace
Dim olfolder As Outlook.MAPIFolder
Dim olitem As Outlook.MailItem

Set olnamespace = Application.GetNamespace("MAPI")
Set olfolder = olnamespace.GetDefaultFolder(olFolderInbox). _
Folders("Inbox subfolder")




For O = 1 To Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) _
    .Folders("Inbox subfolder").Items.Count
Next O

'add in a small loop so that while the rule moves the email 
'it loops and doesn't send an earlier email
Dim u As Double
u = 1
Do Until u > 1000
u = u + 1

Loop

If N = O Then
Dim myMessage As MailItem
Set myMessage = Application.CreateItem(ItemType:=olMailItem)
With myMessage
    .To = "INSERTCELLPHONEHERE@messaging.sprintpcs.com"
    .Body=Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) _
    .Folders("Inbox subfolder").Items(N - 1).Body
    .Send
End With
End If

Just insert your cellphone number where it says INSERTCELLPHONEHERE in the above code. If you have a different cell phone provider than Sprint, you can substitute the below SMS logic instead of @messaging.sprintpcs.com.

How to Set-up Rule:

The below video will show you how to connect your Microsoft Outlook to your cell phone so that you get a text message every time you receive a new email into your Outlook inbox. This text message system works every time you get a new email even if your computer is locked or sleeping as long as it's turned on.

If you want to forward your gmails to this email so that this email will text your phone do the below in GMAIL: