VBA for Outlook Web App

Hi,

I have excel template with VBA that generates XML and e-mails data using Outlook. I just found out that some users do not have/use Outlook, but instead are using Outlook Web App. Is it possible to modify code to use Outlook Web App instead of Outlook. If so, how would I do that. I am novice in dealing with VBA.

Current VBA attached.

Thanks.
Option Explicit

Private doc As Object 'As MSXML2.DOMDocument60
Private mstrFile As String
Private mstrPath As String

Public Function SendEmail(Optional ByVal FileToAttach As String, _
    Optional ByVal XML As String, _
    Optional ByVal Recipient As String, _
    Optional ByVal CC As String, _
    Optional ByVal Subject As String) As Boolean
    Dim wb As Excel.Workbook
    Dim strXMLFile As String
    Dim strGuid As String
    Dim oAPP ' As Outlook.Application
    Dim oAct ' As Outlook.Account
    Dim iMsg ' As Outlook.MailItem
    On Error GoTo errhandler

    If LoadXMLDocument = False Then
    Err.Raise Err.Number
    Exit Function
    End If
    

    Set oAPP = GetObject(, "Outlook.Application")
    Set iMsg = oAPP.CreateItem(0)
    With iMsg
        .To = Sheets("Control").Range("ReturnTo")
        .Subject = "Cash report for " & GetValue("Location", 1)
        .Body = "You can attach the xml as a file or just make it the body of the message like this " & vbCrLf & vbCrLf & vbCrLf & doc.XML
        .Attachments.Add mstrPath & mstrFile
        .Send
        'LogEvent "Email sent", "modUtility", "SendEmail", "Logging", "Email Sent to ", Recipient
    End With

    SendEmail = True
    Exit Function

errhandler:
    Select Case Err.Number
        Case 429
            Set oAPP = CreateObject("Outlook.Application")
            Resume Next
        Case Else
        MsgBox "Error Number:" & Err.Number & vbCrLf & Err.Description, vbExclamation
        'Resume
    End Select
End Function



Public Function GetValue(strName As String, Optional intSheet As Integer = 2)
    Dim str As String
    str = Sheets(intSheet).Range(strName)
    
    GetValue = str
End Function


Private Function LoadXMLDocument() As Boolean
    Dim tblH As ListObject
    Dim tblD As ListObject
    Dim strBuff As String
    Dim strH As String
    Dim strD As String
    Dim strXML As String
    Dim i As Integer
    Dim rw As ListRow
    Dim strGuid As String
    
    Set tblH = Sheets("Control").ListObjects("tblHeader")
    Set tblD = Sheets("Control").ListObjects("tblData")
    
    For Each rw In tblH.ListRows
        strH = strH & rw.Range(3)
    Next
    
    For Each rw In tblD.ListRows
        strD = strD & rw.Range(3)
    Next
    
    strH = "<Headers>" & strH & "</Headers>"
    strD = "<Data>" & strD & "</Data>"
    strXML = "<Response>" & strH & strD & "</Response>"
    
    Set doc = New MSXML2.DOMDocument60
    If doc.LoadXML(strXML) Then
        strGuid = GetGUID
        mstrFile = strGuid & ".xml"
        mstrPath = ActiveWorkbook.Path & "\"
        doc.Save mstrPath & mstrFile
        LoadXMLDocument = True
    Else
        MsgBox "Error loading document", vbCritical, ActiveWorkbook.Name
    End If

End Function
Private Sub Class_Terminate()
    Set doc = Nothing
End Sub

Public Function GetGUID() As String
    GetGUID = Mid$(CreateObject("Scriptlet.TypeLib").GUID, 2, 36)
End Function

Open in new window

ZanetabetaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Alexei KuznetsovMicrosoft Outlook MVPCommented:
No, you can't. Using VBA like yours requires desktop Outlook to be installed.
0
QlemoBatchelor, Developer and EE Topic AdvisorCommented:
There *might* be a way to access mails via PowerShell without using Outlook, but odds are that not.
0
ZanetabetaAuthor Commented:
Actually I found a solution in another place. It can be done. I just needed a sample code like this:

Public Function TestSendByGmail()

    Dim objEmail As Object
    Dim objConf As Object
    Dim objFlds As Object
     
    On error resume next

    Set objEmail = CreateObject("CDO.Message")
    Set objConf = CreateObject("CDO.Configuration")
    Set objFlds = objConf.Fields
    
    objFlds.item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objFlds.item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    objFlds.item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    objFlds.item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    objFlds.item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "youremailaddress to login gmail"
    objFlds.item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "yourpassword to login gmail"
    objFlds.item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
    objFlds.Update
    
    objEmail.From = "your email address"
    objEmail.To = "who you are sending to"
    objEmail.Subject = "Test Send By Gmail"
    objEmail.TextBody = "Hello"
    objEmail.Sender = "Fred"
    objEmail.Configuration = objConf
    objEmail.Send
    If err.Number <> 0 Then
        MsgBox "Error in sending. " & err.Description
    Else
        MsgBox "Sent" 
    End If
    
    Set objFlds = Nothing
    Set objConf = Nothing
    Set objEmail = Nothing
    
End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
QlemoBatchelor, Developer and EE Topic AdvisorCommented:
This does not use Outlook Web App, but that is of no importance for your goal. Using CDO should indeed work.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.