Image not received, sent via mms using VBA, Twilio and Microsoft ACCESS - vba

I need to send a image from my pc in a text message using Twilio and Microsoft Access.
I was able to successfully send a text message via Microsoft Access. However, the image wasn't sent. I found a parameter called "mediaURL". I am trying to have mediaURL refer to a image on my pc ("d:\imagefolder").
Has anyone been able to do this. Here is my code to send the text message.
Dim MessageUrl As String
Dim FromURLEncode As String
Dim ToURLEncode As String
Dim imageURL As String
On Error GoTo Error_Handler
' setup the URL
MessageUrl = BASEURL & "/2010-04-01/Accounts/" & ACCOUNTSID & "/Messages"
imageURL = "d:\imagefolder\mypicture.png"
' setup the request and authorization
Dim http As MSXML2.XMLHTTP60
Set http = New MSXML2.XMLHTTP60
http.Open "POST", MessageUrl, False, ACCOUNTSID, AUTHTOKEN
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
Dim postData As String
postData = "From=" & fromNumber _
& "&To=" & toNumber _
& "&Body=" & body _
& "&MediaURL=" & imageURL
Debug.Print postData
' send the POST data
http.send postData
' optionally write out the response if you need to check if it worked
Debug.Print http.responseText
If http.Status = 201 Then
ElseIf http.Status = 400 Then
MsgBox "Failed with error# " & _
http.Status & _
" " & http.statusText & vbCrLf & vbCrLf & _
http.responseText
ElseIf http.Status = 401 Then
MsgBox "Failed with error# " & http.Status & _
" " & http.statusText & vbCrLf & vbCrLf
Else
MsgBox "Failed with error# " & http.Status & _
" " & http.statusText
End If
Exit_Procedure:
On Error Resume Next
' clean up
Set http = Nothing
Exit Function
Error_Handler:
Select Case Err.Number
Case NOINTERNETAVAILABLE
MsgBox "Connection to the internet cannot be made or " & _
"Twilio website address is wrong"
Case Else
MsgBox "Error: " & Err.Number & "; Description: " & Err.Description
Resume Exit_Procedure
Resume
End Select

I was finally able to send text messages with images by using MediaUrl. My Code was using MediaURL. It has to be exactly "MediaUrl". Once, I figured that out, I have been able to send text messages with images.

Twilio developer evangelist here.
As Thomas G answered in a comment, your problem is that the image is on your computer. The URL needs to be available to Twilio.
You will need to upload the image to a server, either your own or a public service, and then using the for that server.
Check out the documentation on sending MMS with Twilio for more details.

Related

How to use ServerXMLHTTP60 and a client SSL certificate in Excel using VBA?

I cannot get it to work in VBA - Excel. I use the same header and XML-body in Postman - fine! Good response. I need to use a client certificate to identify myself, but I cannot get it done in VBA. The code needs to post some data (the XMLPostMessage) and then it receives some data from the server (a XML message as well).
The response I get from the server is a message in XML that has something to do with "Unidentified user". So, I do have communication, but it is not recognised as 'from a trusted party'. But using this certificate in Postman does give a good response.
== My VBA code: ==
Public Sub server()
Dim O As New ServerXMLHTTP60
Dim xmlDoc As New MSXML2.DOMDocument60
Dim XMLPostMessage As String
XMLPostMessage = "<WEB-UAS-AANVR>" & _
"<ALG-GEG>" & _
"<PROC-IDENT>3637</PROC-IDENT>" & _
"<PROC-FUNC>1</PROC-FUNC>" & _
"<INFO-GEBR>DITISEENTEST</INFO-GEBR>" & _
"</ALG-GEG>" & _
"<WEB-UAS-GEG>" & _
"<UAS-VRR-EXAMEN-GEG>" & _
"<UAS-VRR-EX-INST></UAS-VRR-EX-INST>" & _
"<UAS-VRR-EX-SRT>A2</UAS-VRR-EX-SRT>" & _
"<UAS-VRR-EX-DAT>20211210</UAS-VRR-EX-DAT>" & _
"<GEB-DAT-UAS-VRR>19840726</GEB-DAT-UAS-VRR>" & _
"<UAS-VRR-EX-REF>#12345</UAS-VRR-EX-REF>" & _
"</UAS-VRR-EXAMEN-GEG>" & _
"</WEB-UAS-GEG>" & _
"</WEB-UAS-AANVR>"
With O
.Open "POST", "https://<the serverpath goes here>", False
.setRequestHeader "Content-type", "application/xml"
.setRequestHeader "Content-type", "text/xml"
.setRequestHeader "Charset", "UTF-8"
.setOption 3, "<The Friendly Name of the certificate goes here>"
' .setOption 3, "CURRENT_USER\My\<The Friendly Name of the certificate goes here>"
.send XMLPostMessage
xmlDoc.LoadXML (O.responseXML.XML)
Debug.Print xmlDoc.XML
If Not .Status = 200 Then
MsgBox "UnAuthorized. Message: " & .Status & " - " & .statusText
Exit Sub
End If
End With
Set O = Nothing
End Sub

Sending meeting requests using ical through outlook

Here is my dilemma. I have a vb.net application for requesting time using an asset. The user submits a request (can contain required and optional users), then an approver has to approve it. When it is approved, I want to send a meeting request. I can't do it using outlook code since it won't let me change the organizer. If I try to send it using outlook.application > outlook.olitemtype.olappointmentitem or whatever it is, it will default the organizer to the person sending the meeting request, which in this case is the approver, which I don't want. So I think I am left with trying to send an ical. This is where I am having issues. I can't use smtpclient to create the email and send it using the proper content-type, etc. I have to send it using outlook. So I create an ics file and add it as an attachment. I am not sure the difference between METHOD:PUBLISH and METHOD:REQUEST. All the searches I've have done say I should use method:request, but when i open the ICS file, it doesn't give me the options to accept, etc. It doesn't add to my calendar. I want the ability to be able to update and cancel the meeting as well, which I think I know how to do with uid, sequence, etc. I've done searches and just can't get to where I need to be. It looks like the best option is to use smtpclient to create the mail message where you add the headers and ical stuff, but I can't do that, is there a way to it using outlook?
If someone can help point me in the right direction, I would greatly appreciate it.
Here is my current code:
Dim msg As MailMessage = New MailMessage
msg.From = New MailAddress(br.requesting_user_email)
msg.To.Add(New MailAddress(br.requesting_user_email))
msg.Subject = variables.UserInfo.last_name & ", " + variables.UserInfo.first_name & " has approved your request through the Bench Scheduler."
Dim bodytxt As String = "User: " & variables.UserInfo.last_name & ", " + variables.UserInfo.first_name & vbLf & "5+2: " + variables.UserInfo.username & vbLf & vbLf
bodytxt += "Has approved your bench request for " & br.program_name & " - " & br.project_name & "." & vbLf & vbLf
bodytxt += "Start: " & br.start_time & vbLf & "End: " & br.end_time & vbLf
bodytxt += "Bench: " & br.bench_name & vbLf & "Priority: " & br.priority & vbLf & "Purpose: " & br.objective & vbLf & vbLf
bodytxt += "Request Notes: " & br.notes & vbLf & vbLf
bodytxt += vbLf & vbLf & vbLf & "This email was automatically generated by Bench Scheduler. You may respond to this email."
msg.Body = bodytxt
Dim str As StringBuilder = New StringBuilder
str.AppendLine("BEGIN:VCALENDAR")
str.AppendLine("PRODID:-//Microsoft Corporation//Outlook 15.0 MIMEDIR//EN")
str.AppendLine("VERSION:2.0")
If cancel Then
str.AppendLine("METHOD:CANCEL")
Else
str.AppendLine("METHOD:REQUEST")
End If
str.AppendLine("BEGIN:VEVENT")
str.AppendLine("X-MS-OLK-FORCEINSPECTOROPEN:TRUE")
str.AppendLine("BEGIN:VTIMEZONE")
str.AppendLine("TZID:Eastern Standard Time")
str.AppendLine("BEGIN:STANDARD")
str.AppendLine("DTSTART:16011104T020000")
str.AppendLine("RRULE:FREQ=YEARLY;BYDAY=1SU;BYMONTH=11")
str.AppendLine("TZOFFSETFROM:-0400")
str.AppendLine("TZOFFSETTO:-0500")
str.AppendLine("END:STANDARD")
str.AppendLine("BEGIN:DAYLIGHT")
str.AppendLine("DTSTART:16010311T020000")
str.AppendLine("RRULE:FREQ=YEARLY;BYDAY=2SU;BYMONTH=3")
str.AppendLine("TZOFFSETFROM:-0500")
str.AppendLine("TZOFFSETTO:-0400")
str.AppendLine("END:DAYLIGHT")
str.AppendLine("END:VTIMEZONE")
Dim dt As New DataTable
Dim ta As New BSDataSetTableAdapters.getUserRequestTableAdapter
dt = ta.GetData(br.request_id, "T")
For Each row As DataRow In dt.Rows
If row("type") = "Required" Then
str.AppendLine(String.Format("ATTENDEE;CN='{0}';RSVP=TRUE:mailto:{1}", row("username"), row("email")))
ElseIf row("type") = "Optional" Then
str.AppendLine(String.Format("ATTENDEE;CN='{0}';ROLE=OPT-PARTICIPANT;RSVP=TRUE:mailto:{1}", row("username"), row("email")))
End If
Next
str.AppendLine("CLASS:PUBLIC")
str.AppendLine("CREATED:" & Format(Date.Now, "yyyyMMddTHHmmssZ"))
str.AppendLine(String.Format("DESCRIPTION:{0}", br.objective))
str.AppendLine("DTEND;TZID=" & """" & "Eastern Standard Time" & """" & ":" & Format(CDate(br.end_time), "yyyyMMddTHHmmss"))
str.AppendLine("DTSTAMP:" & Format(Date.Now, "yyyyMMddTHHmmssZ"))
str.AppendLine("DTSTART;TZID=" & """" & "Eastern Standard Time" & """" & ":" & Format(CDate(br.start_time), "yyyyMMddTHHmmss"))
str.AppendLine(String.Format("LOCATION:{0}", br.bench_name))
str.AppendLine(String.Format("ORGANIZER;CN='" & br.requesting_username & "':mailto:" & br.requesting_user_email))
str.AppendLine("PRIORITY:5")
str.AppendLine("SEQUENCE:0")
str.AppendLine(String.Format("SUMMARY;LANGUAGE=en-us:{0}", "Approved Bench Request (ID-" & br.request_id & "): " & br.program_name & "-" & br.project_name & "-" & br.activity))
str.AppendLine("TRANSP:OPAQUE")
str.AppendLine(String.Format("UID:{0}", br.uid))
str.AppendLine(String.Format("X-ALT-DESC;FMTTYPE=text/html:{0}", br.objective))
str.AppendLine("X-MICROSOFT-CDO-BUSYSTATUS:BUSY")
str.AppendLine("X-MICROSOFT-CDO-IMPORTANCE:1")
str.AppendLine("X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY")
str.AppendLine("X-MICROSOFT-DISALLOW-COUNTER:FALSE")
str.AppendLine("X-MS-OLK-AUTOFILLLOCATION:FALSE")
str.AppendLine("X-MS-OLK-CONFTYPE:0")
str.AppendLine("BEGIN:VALARM")
str.AppendLine("TRIGGER:-PT30M")
str.AppendLine("ACTION:DISPLAY")
str.AppendLine("DESCRIPTION:Reminder")
str.AppendLine("END:VALARM")
str.AppendLine("END:VEVENT")
str.AppendLine("END:VCALENDAR")
Dim smtpclient As SmtpClient = New SmtpClient
smtpclient.Host = "replaced for privacy"
smtpclient.Credentials = System.Net.CredentialCache.DefaultNetworkCredentials
Dim contype As System.Net.Mime.ContentType = New System.Net.Mime.ContentType("text/calendar")
contype.Parameters.Add("method", "REQUEST")
contype.Parameters.Add("name", "Meeting.ics")
Dim avcal As AlternateView = AlternateView.CreateAlternateViewFromString(str.ToString, contype)
msg.AlternateViews.Add(avcal)
smtpclient.Send(msg)

URL monitor keeps increasing memory usage

I have written a URL monitoring program in vb using .net 4.0. Basically it sets a timer checks the url every 60 minutes using an htpwebreques/httpwebresponse and sends an email if the url is down. However the memory used by the application keeps increasing every time the url is checked. This will obviously eventually cause a problem as the app is designed to run permanently monitoring a website for availability and the monitoring machine will eventually run out of resources.
Code for my CheckURL routine below. Any advice greatly appreciated, thanks in advance.
Private Sub checkURL()
Timer1.Stop()
Dim wReq As HttpWebRequest
Dim wResp As HttpWebResponse ' WebResponse
wReq = HttpWebRequest.Create(url)
wReq.Method = "HEAD"
Try
wResp = wReq.GetResponse()
If wResp.StatusCode = 200 Then
txtResponse.Text = wResp.StatusCode & ": " & wResp.StatusDescription & vbNewLine & "The " & siteName & " is up"
'Only send success results if specified
If sendOnFailure = False Then
sendResults = True
End If
Else txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "Please verify manually that it is operational." & vbNewLine & "The response received was:" & vbNewLine & "Status Code: " & wResp.StatusCode & " - " & wResp.StatusDescription
sendResults = True
End If
wResp.Close()
wResp = Nothing
wReq = Nothing
Catch ex As Exception
txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "The error returned was:" & vbNewLine & ex.ToString
sendResults = True
End Try
txtLastCheck.Text = Now.ToString("d MMM yyyy HH:mm")
setNextCheck()
End Sub
First, you should use Option Strict On, which will show you where you have variable type mismatches and may even suggest corrections for you, for example, see where the DirectCast operator is used in the following code.
Second, HttpWebResponse has a .Dispose() method, so you should call that when you have finished using it, or, as Zaggler pointed out, you can use Using to ensure that unmanaged resources are cleaned up properly, thus removing the memory leak you are concerned with. Note that there may be other similar problems in the code we can't see.
You should not set things to Nothing in an attempt to get rid of them - doing so messes with the garbage collector and does nothing to ensure their clean disposal.
Option Strict On
' ....
Private Sub checkURL()
timer1.Stop()
Dim wReq As HttpWebRequest = DirectCast(HttpWebRequest.Create(url), HttpWebRequest)
wReq.Method = "HEAD"
Try
Using wResp As HttpWebResponse = DirectCast(wReq.GetResponse(), HttpWebResponse)
If wResp.StatusCode = 200 Then
txtResponse.Text = wResp.StatusCode & ": " & wResp.StatusDescription & vbNewLine & "The " & siteName & " is up"
'Only send success results if specified
If sendOnFailure = False Then
sendResults = True
End If
Else txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "Please verify manually that it is operational." & vbNewLine & "The response received was:" & vbNewLine & "Status Code: " & wResp.StatusCode & " - " & wResp.StatusDescription
sendResults = True
End If
wResp.Close()
End Using
Catch ex As Exception
txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "The error returned was:" & vbNewLine & ex.ToString
sendResults = True
End Try
txtLastCheck.Text = Now.ToString("d MMM yyyy HH:mm")
setNextCheck()
End Sub

How to post a forum topic with attachment to IBM Connections using Excel VBA

I am trying to post a forum topic with attached image file to IBM Connections 5.0 using Excel VBA.
According to IBM Connections API description a multipart request will be required here.
What I already managed is to post a forum topic without attachment and also attaching a text or image file to an existing wiki page. Therefore I assume that the problem is not related with these aspects but rather with the correct formatting of the multipart request. API description is not very clear to me here and I tried several things I found about multipart requests in other help forums. But all I get is a response "400 bad request".
Maybe some of you experts can give me a hint about my code:
Public Sub CreateForumPost()
Const sBoundary As String = "2588eb82-2e1c-4aec-9f4f-d65a3ecf8fab"
Dim oHttp As MSXML2.xmlhttp
Dim sUrl As String
Dim sBody As String
'create XMLHTTP object and URL
Set oHttp = CreateObject("MSXML2.XMLHTTP")
sUrl = "https://my-connect-server/forums/atom/topics?forumUuid=9e51cbfb-4b1d-405d-9835-dbd087c49a65"
'create forum post
sBody = "--" & sBoundary & vbCrLf
sBody = sBody & "<?xml version=""1.0"" encoding=""UTF-8""?>"
sBody = sBody & "<entry xmlns=""http://www.w3.org/2005/Atom"" xmlns:app=""http://www.w3.org/2007/app"" xmlns:snx=""http://www.ibm.com/xmlns/prod/sn"">"
sBody = sBody & "<category scheme=""http://www.ibm.com/xmlns/prod/sn/type"" term=""forum-topic""/>"
sBody = sBody & "<title type=""text""> " & "My Title" & " </title>"
sBody = sBody & "<category term=""question"" scheme=""http://www.ibm.com/xmlns/prod/sn/flags""/>"
sBody = sBody & "<category term=""" & "my-tag" & """/>"
sBody = sBody & "<content type=""html""> " & "My post content" & " </content>"
sBody = sBody & "</entry>" & vbCrLf
sBody = sBody & "--" & sBoundary & vbCrLf
sBody = sBody & "Content-Disposition: attachment; filename=""dummy.txt""" & vbCrLf & vbCrLf
sBody = sBody & sGetFile("c:\temp\dummy.txt") & vbCrLf
sBody = sBody & "--" & sBoundary & "--" & vbCrLf
Call oHttp.Open("POST", sUrl, False)
Call oHttp.setRequestHeader("Content-Type", "multipart/related;boundary=" & sBoundary & ";type=""application/atom+xml""")
Call oHttp.send(pvToByteArray(sBody))
If oHttp.Status = 201 Then
Call MsgBox("success")
Else
Call MsgBox("error")
Stop
End If
End Sub
Private Function sGetFile(sName As String) As String
Dim abyContent() As Byte
Dim iNumber As Integer
Dim lLen As Long
lLen = FileLen(sName)
If lLen > 0 Then
ReDim abyContent(lLen - 1)
iNumber = FreeFile
Open sName For Binary Access Read As iNumber
Get iNumber, , abyContent
Close iNumber
sGetFile = StrConv(abyContent, vbUnicode)
Else
sGetFile = ""
End If
End Function
Function pvToByteArray(sText As String) As Byte()
pvToByteArray = StrConv(sText, vbFromUnicode)
End Function
We found out what the problem was. It was indeed about the formatting of the multipart request. You need to be very careful with the CrLf characters ...
Public Sub CreateForumPost()
'...
'create forum post
sBody = vbCrLf & "--" & sBoundary & vbCrLf & vbCrLf
'...
sBody = sBody & sGetFile("c:\temp\dummy.txt") & vbCrLf
sBody = sBody & "--" & sBoundary & "--"
'...
End Sub
Now it works. Nevertheless many thanks for your support!

MSXML2.DOMDocument load function fails in VBA

I've been struggling with the below issue for a while now and couldn't find the solution yet.
There is an iShare page with an XML file that I want to download using VBA code, then later process the XML file and save into MS Access database.
I've been using the below code for about 4 years now, it worked perfectly without any issues. But suddenly it stopped working this week.
Any ideas why?
the code:
Private Function GetRequests() As Boolean
On Error GoTo ErrHandler
Dim oDoc As MSXML2.DOMDocument
Dim Url As String
Dim sFileName As String
Set oDoc = New MSXML2.DOMDocument
oDoc.async = False
Url = cUrlDatabase & "/" & cApplicationName & "/In/" & cReqXmlFile
UpdateStatus "Loading " & cReqXmlFile
If Not oDoc.Load(Url) Then
c_sLastError = "Could not load XML " & Url
GoTo EndProc
End If
sFileName = sPath & "\Data\requests.xml"
oDoc.Save sFileName
GetRequests = True
End Function
The code fails at the oDoc.Load(Url) part, it comes back false.
Here's an example of how to gather error details:
Dim xDoc As MSXML.DOMDocument
Set xDoc = New MSXML.DOMDocument
If xDoc.Load("C:\My Documents\cds.xml") Then
' The document loaded successfully.
' Now do something intersting.
Else
' The document failed to load.
Dim strErrText As String
Dim xPE As MSXML.IXMLDOMParseError
' Obtain the ParseError object
Set xPE = xDoc.parseError
With xPE
strErrText = "Your XML Document failed to load" & _
"due the following error." & vbCrLf & _
"Error #: " & .errorCode & ": " & xPE.reason & _
"Line #: " & .Line & vbCrLf & _
"Line Position: " & .linepos & vbCrLf & _
"Position In File: " & .filepos & vbCrLf & _
"Source Text: " & .srcText & vbCrLf & _
"Document URL: " & .url
End With
MsgBox strErrText, vbExclamation End If
Set xPE = Nothing
End If
Example taken from here.
For other people finding this post:
The xml parser by now has implemented different error types (see here).
You would have to use the following code
Set objXML = CreateObject("Msxml2.DOMDocument.6.0")
ObjXML.async=true
objXML.load "/path/to/xml"
If objXML.parseError.errorCode <> 0 Then
MsgBox "Error was " + objXML.parseError.reason
End If
This should help you debug your .xml file.
For anyone else struggling with this, I found this error to be caused by text encoded in a format which could not be parsed in VBA (some weird E symbol). The objXML was nothing after the .load. I'm sure there are many possible causes, but I'll share what I found in case this helps someone. Thanks to the guys above for the error handling routines.