I'm trying to pass textbox values from an Outlook userform to an asmx web service. I've done this successfully with PHP but now need to do so with VBA. Currently the form does absolutely nothing on submit. I believe something is wrong with what or how I'm passing to the send method. Any suggestions how I can get this to work?
CliAcctNo = TicketCreateForm1.CliAcctNo.Value
ContactName = TicketCreateForm1.ContactName.Value
ContactNum = TicketCreateForm1.ContactNum.Value
Ext = TicketCreateForm1.Ext.Value
Email = TicketCreateForm1.Email.Value
TicketTitle = TicketCreateForm1.TicketTitle.Value
TicketDesc = TicketCreateForm1.Desc.Value
'DataToPost = ("cliacctno=44121&pname=John&pnum=404-223-9655&ext=0&emailaddress=john#noemail.com&tickettitle=test from vab&ticketdetails=test line item vba")
'objEvn.Parameters.Create "Test", "Test"
DataToPost = ("CliAcctNo&ContactName&ContactNum&Ext&Email&TicketTitle&TicketDesc")
Set objHttp = New MSXML2.XMLHTTP
'Set objHttp = New MSXML2.XMLHTTPRequest
objHttp.Open "POST", "http://localhost/test/test.asmx"
objHttp.setRequestHeader "Content-Type", "text/xml"
'objHttp.setRequestHeader "SOAPAction", "CreateTicket"
objHttp.setRequestHeader "SOAPAction", "tempri.org/CreateTicket"
objHttp.Send (DataToPost)
In your posted code you're sending a fixed string to the web service: you need to somehow include your parameters in that -
CliAcctNo = TicketCreateForm1.CliAcctNo.Value
ContactName = TicketCreateForm1.ContactName.Value
ContactNum = TicketCreateForm1.ContactNum.Value
Ext = TicketCreateForm1.Ext.Value
Email = TicketCreateForm1.Email.Value
TicketTitle = TicketCreateForm1.TicketTitle.Value
TicketDesc = TicketCreateForm1.Desc.Value
'DataToPost = ("cliacctno=44121&pname=John&pnum=404-223-9655&ext=0&emailaddress=john#noemail.com&tickettitle=test from vab&ticketdetails=test line item vba")
DataToPost = "cliacctno=" & CliAcctNo & _
"pname=" & ContactName & _
"pnum=" & ContactNum & _
"ext=" & Ext & _
"emailaddress=" & Email & _
"tickettitle=" & TicketTitle & _
"ticketdetails=" & TicketDesc
Related
i have tried using google translate to translate names from language to another using c# and its working fine but now im trying to do the same thing using ms access vba i have tried so many ways but with no luck!
this is the code written in c# and its working fine
public string trans_arabic_to_english(string word)
{
var toLanguage = "en";//English
var fromLanguage = "ar";//Deutsch
var url = $"https://translate.googleapis.com/translate_a/single?client=gtx&sl={fromLanguage}&tl={toLanguage}&dt=t&q={HttpUtility.UrlEncode(word)}";
var webClient = new WebClient
{
Encoding = System.Text.Encoding.UTF8
};
var result = webClient.DownloadString(url);
try
{
result = result.Substring(4, result.IndexOf("\"", 4, StringComparison.Ordinal) - 4);
return result;
}
catch
{
return "Error";
}
}
this is the code in vba
Private Sub Command0_Click()
Dim toLan As String, fromLan As String, resp As String, s As String, a_name As String, url As String
toLang = "ar"
fromlang = "en"
a_name = "omar khalil"
url = "https://translate.googleapis.com/translate_a/single?"
url = url & "client=gtx&sl={""" & toLang & """}&tl={""" & fromlang & """}&dt=t&q={""" & a_name & """}"
url = "https://translate.googleapis.com/translate_a/single?client=gtx&sl="
url = url & fromlang & "&tl=" & to_lang & "&dt=t&q=" & a_name
'==
Dim ob As Object
Set ob = CreateObject("WinHttp.WinHttpRequest.5.1")
ob.Open "POST", url, False
ob.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
ob.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
ob.Send
If ob.Status <> 200 Then
resp = ob.ResponseText
MsgBox resp
End Sub
i have tried using WinHttp also with no luck at all!
any one can help me with this issue Thanks .
Try the next function, please:
Private Function GTranslate(strInput As String, strFromLang As String, strToLang As String) As String
Dim strURL As String, objHTTP As Object, objHTML As Object, objDivs As Object, objDiv As Variant
strURL = "https://translate.google.com/m?hl=" & strFromLang & _
"&sl=" & strFromLang & _
"&tl=" & strToLang & _
"&ie=UTF-8&prev=_m&q=" & strInput
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.Open "GET", strURL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.Send ""
Set objHTML = CreateObject("htmlfile")
With objHTML
.Open
.Write objHTTP.responseText
.Close
End With
Set objDivs = objHTML.getElementsByTagName("div")
For Each objDiv In objDivs
'If objDiv.className = "t0" Then 'it does not work, anymore
If objDiv.className = "result-container" Then 'adapted on December 28th
GTranslate = objDiv.innerText: Exit For
End If
Next objDiv
Set objHTML = Nothing: Set objHTTP = Nothing
End Function
It can be called in the next way:
Sub testTranslateG()
MsgBox GTranslate("Este es un libro", "auto", "en")
End Sub
The second parameter can be "auto" (like in the testing Sub), or the specific language abbreviation if more accurate translation needed ("es" - Spanish, "ru" - Russian, "ro" - Romanian etc.).
In order to find the correct abbreviation, you can open Google Translate page, right click and choose 'View page source'. Then try finding some language. Let us say Spanish. In that area you will see a script having strings like the following one: "code:'it',name:'Italian'". Easy to understand that "it" is the abbreviation for Italian...
I originally created a VBA macro that would uses IE automation to click specific form buttons on an ASPX page. The page has 5 form options you have to pass through.
drop down list for group
drop down list for location
Graphical calendar where you select the date
List box for area's
Generate Report button
I would like to move away from using the IE automation to something more efficient. I have seen other posts where they were able to pull the data back using the MSXML object. This is what I was able to build from what I read but am not having any luck figuring out how to pass more than one of the form options. This is a company specific/internal website so unfortunately it is not available externally for me to be able to post the link example.
The element ID's are as follows; dlDivision, dlLocation, calRptDate, lbAreas, btnGenReport.
Public Sub XMLhttp_Search_Extract()
Dim URL As String
Dim XMLreq As Object
Dim POSTdata As String
Dim i As Integer
URL = "somewebURL.test.aspx"
POSTdata = "(" & Q("dlDivision") & ":" & Q("divisionNAMEHERE") & "," & Q("dlLocation") & ":" & Q("123 - Location") & ")"
Set XMLreq = CreateObject("MSXML2.XMLHTTP")
With XMLreq
.Open "POST", URL, False
.setRequestHeader "User-Agent", "Moilla/5.0 (Windows NT 5.1; rv:23.0) Gecko/20100101 Firefox/23.0"
.setRequestHeader "Referer", "somewebURL.test.aspx"
.setRequestHeader "Content-Type", "application/json; charset=utf-8"
.Send (POSTdata)
For i = 1 To Len(.responseText) Step 1023
MsgBox Mid(.responseText, i, i + 1023), _
Title:=i & " to " & Min(i + 1023 - 1, Len(.responseText)) & " of " & Len(.responseText)
Next i
End With
End Sub
Private Function Q(text As String) As String
Q = Chr(34) & text & Chr(34)
End Function
Private Function Min(n1 As Long, n2 As Long) As Long
Min = IIf(n1 < n2, n1, n2)
End Function
I send messages form Excel to telegram. It works nice.
But how can I send a photo? I don't understand it (https://core.telegram.org/bots/api#sendphoto)
Thanks for help!
My send Message:
Dim objRequest As Object
Dim strChatId As String
Dim strMessage As String
Dim strPostData As String
Dim strResponse As String
strChatId = Worksheets("Einstellungen").Cells(3, "AB")
strMessage = Report
APIcode = Worksheets("Einstellungen").Cells(2, "AB")
strPostData = "chat_id=" & strChatId & "&text=" & strMessage
Set objRequest = CreateObject("MSXML2.XMLHTTP")
With objRequest
.Open "POST", "https://api.telegram.org/" & APIcode & "/sendMessage?", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (strPostData)
GetSessionId = .responseText
End With
If your code is working as-is for plain text messages then you should only need to make a couple changes to it.
You're probably currently using the API's sendMessage method, which takes the chat_id and text parameters.
You want to use the sendPhoto method, which tales the chat_id and photo parameters (but no text parameter).
So this is a bit of a shot in the dark since I've never used or heard of Telegram and I don't have a key, so I can't test it, but theoretically, you could send a photo from a URL like this:
Sub telegram_SendPhoto()
Const photoURL = "https://i.imgur.com/0eH6d1v.gif" 'URL of photo
Dim objRequest As Object, strChatId As String, APIcode As String
Dim strPostData As String, strResponse As String
strChatId = Worksheets("Einstellungen").Cells(3, "AB")
APIcode = Worksheets("Einstellungen").Cells(2, "AB")
strPostData = "chat_id=" & strChatId & "&photo=" & photoURL
Set objRequest = CreateObject("MSXML2.XMLHTTP")
With objRequest
.Open "POST", "https://api.telegram.org/" & APIcode & "/sendPhoto?", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (strPostData)
strResponse = .responseText
End With
MsgBox strResponse
End Sub
Pass a file_id as String to send a photo that exists on the Telegram servers (recommended), pass an HTTP URL as a String for Telegram to get a photo from the Internet (above), or upload a new photo using multipart/form-data. More info on Sending Files ยป
I have created a WCF WebService having multiple svc files. I call the method in the svc file from vbscript using below code:
ScriptTimeOut = 6000000
Dim soapServer, soapMessage
soapServer = "https://example.com/marketyardwebservice/SchedulerClasses/MailIntimations.svc"
soapMessage = "<s:Envelope xmlns:s=" & GetQuotedUrl("http://schemas.xmlsoap.org/soap/envelope/") & ">" & _
"<s:body>" & _
"<AuctionWinnerSendMail xmlns=" & GetQuotedUrl("http://tempuri.org/") & ">" & _
""
soapMessage = Replace(soapMessage, "'", chr(34))
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.SetOption 2, xmlhttp.GetOption(2)
Dim lResolve,lConnect,lSend,lReceive
lResolve = 5 * 1000
lConnect = 60 * 1000
lSend = 600 * 1000
lReceive = 600 * 1000
xmlhttp.setTimeouts lResolve, lConnect, lSend, lReceive
xmlhttp.open "POST", soapServer, False
xmlhttp.setRequestHeader "Man", POST & " " & soapServer & " HTTP/1.1"
xmlhttp.setRequestHeader "SOAPAction", "http://tempuri.org/IMailIntimations/AuctionWinnerSendMail"
xmlhttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
xmlhttp.send(soapMessage)
Function GetQuotedUrl(ByVal value)
GetQuotedUrl = Chr(34) & value & Chr(34)
End Function
The above script gets executed properly when https is not enabled. But as soon as I enable HTTPS, I am getting the following error when the vbscript gets executed "A certificate is required to complete client authentication".
Please can anybody help me, as to how i can resolve this issue.
Thanks in advance
When you enable HTTPS on your server set Client Certificates to Ignore.
Greetings to the well of knowledge...
I've been reading the numerous posts on this particular error and have not found anything that resolves my particular issue.
I have some VBA code within an Access 2010 front-end. Sometimes, but not always, I get a "Object variable or With block variable not set." error. My code is as follows:
Public Sub ValidateAddress(PassedAddress As Object, PassedCity As Object, PassedState As Object, _
PassedZIP As Object, PassedCongressionalDistrict As Object, PassedValidated As Object, HomeForm As Form)
On Error GoTo ShowMeError
Dim strUrl As String ' Our URL which will include the authentication info
Dim strReq As String ' The body of the POST request
Dim xmlHttp As New MSXML2.XMLHTTP60
Dim xmlDoc As MSXML2.DOMDocument60
Dim dbs As Database
Dim candidates As MSXML2.IXMLDOMNode, candidate As MSXML2.IXMLDOMNode
Dim components As MSXML2.IXMLDOMNode, metadata As MSXML2.IXMLDOMNode, analysis As MSXML2.IXMLDOMNode
Dim AddressToCheck As Variant, CityToCheck As Variant, StateToCheck As Variant, ZIPToCheck As Variant
Dim Validated As Boolean, District As Variant, MatchCode As Variant, Footnotes As Variant
Dim candidate_count As Long, SQLCommand As String, Start, Finish
' This URL will execute the search request and return the resulting matches to the search in XML.
strUrl = "https://api.smartystreets.com/street-address/?auth-id=<my_auth_id>" & _
"&auth-token=<my_auth_token>"
AddressToCheck = PassedAddress.Value
CityToCheck = PassedCity.Value
StateToCheck = PassedState.Value
If Len(PassedZIP) = 6 Then ZIPToCheck = Left(PassedZIP.Value, 5) Else ZIPToCheck = PassedZIP.Value
' Body of the POST request
strReq = "<?xml version=""1.0"" encoding=""utf-8""?>" & "<request>" & "<address>" & _
" <street>" & AddressToCheck & "</street>" & " <city>" & CityToCheck & "</city>" & _
" <state>" & StateToCheck & "</state>" & " <zipcode>" & ZIPToCheck & "</zipcode>" & _
" <candidates>5</candidates>" & "</address>" & "</request>"
With xmlHttp
.Open "POST", strUrl, False ' Prepare POST request
.setRequestHeader "Content-Type", "text/xml" ' Sending XML ...
.setRequestHeader "Accept", "text/xml" ' ... expect XML in return.
.send strReq ' Send request body
End With
' The request has been saved into xmlHttp.responseText and is
' now ready to be parsed. Remember that fields in our XML response may
' change or be added to later, so make sure your method of parsing accepts that.
' Google and Stack Overflow are replete with helpful examples.
Set xmlDoc = New MSXML2.DOMDocument60
If Not xmlDoc.loadXML(xmlHttp.ResponseText) Then
Err.Raise xmlDoc.parseError.errorCode, , xmlDoc.parseError.reason
Exit Sub
End If
' According to the schema (http://smartystreets.com/kb/liveaddress-api/parsing-the-response#xml),
' <candidates> is a top-level node with each <candidate> below it. Let's obtain each one.
Set candidates = xmlDoc.documentElement
' First, get a count of all the search results.
candidate_count = 0
For Each candidate In candidates.childNodes
candidate_count = candidate_count + 1
Next
Set candidates = xmlDoc.documentElement
Select Case candidate_count
Case 0 ' Bad address cannot be corrected. Try again.
Form_frmPeople.SetFocus
MsgBox "The address supplied does not match a valid address in the USPS database. Please correct this.", _
vbOKOnly, "Warning"
PassedAddress.BackColor = RGB(255, 0, 0)
PassedCity.BackColor = RGB(255, 0, 0)
PassedState.BackColor = RGB(255, 0, 0)
PassedZIP.BackColor = RGB(255, 0, 0)
Exit Sub
Case 1 ' Only one candidate address...use it and return.
For Each candidate In candidates.childNodes
Set analysis = candidate.selectSingleNode("analysis")
PassedAddress.Value = candidate.selectSingleNode("delivery_line_1").nodeTypedValue
Set components = candidate.selectSingleNode("components")
PassedCity.Value = components.selectSingleNode("city_name").nodeTypedValue
PassedState.Value = components.selectSingleNode("state_abbreviation").nodeTypedValue
PassedZIP.Value = components.selectSingleNode("zipcode").nodeTypedValue & "-" & _
components.selectSingleNode("plus4_code").nodeTypedValue
Set metadata = candidate.selectSingleNode("metadata")
PassedCongressionalDistrict.Value = CInt(metadata.selectSingleNode("congressional_district").nodeTypedValue)
PassedValidated.Value = True
Next
Exit Sub
Case Else ' Multiple candidate addresses...post them and allow the user to select.
DoCmd.SetWarnings False
Set dbs = CurrentDb
If IsTableQuery("temptbl") Then dbs.Execute "DROP TABLE temptbl"
dbs.Execute "CREATE TABLE temptbl (Selected BIT, CandidateAddress CHAR(50), CandidateCity CHAR(25), _
CandidateState CHAR(2), CandidateZIP CHAR(10), CandidateCongressionalDistrict INTEGER, _
MatchCode CHAR(1), Footnotes CHAR(30));"
DoCmd.SetWarnings True
Start = Timer
Do While Timer < Start + 1
DoEvents
Loop
For Each candidate In candidates.childNodes
Set components = candidate.selectSingleNode("components")
AddressToCheck = candidate.selectSingleNode("delivery_line_1").nodeTypedValue
CityToCheck = components.selectSingleNode("city_name").nodeTypedValue
StateToCheck = components.selectSingleNode("state_abbreviation").nodeTypedValue
ZIPToCheck = components.selectSingleNode("zipcode").nodeTypedValue & "-" & _
components.selectSingleNode("plus4_code").nodeTypedValue
Set metadata = candidate.selectSingleNode("metadata")
District = metadata.selectSingleNode("congressional_district").nodeTypedValue
Set analysis = candidate.selectSingleNode("analysis")
MatchCode = analysis.selectSingleNode("dpv_match_code").nodeTypedValue
Footnotes = analysis.selectSingleNode("dpv_footnotes").nodeTypedValue
DoCmd.SetWarnings False
dbs.Execute "INSERT INTO temptbl ( CandidateAddress, CandidateCity, CandidateState, CandidateZIP, _
CandidateCongressionalDistrict, MatchCode, Footnotes ) " & vbCrLf & "SELECT """ & AddressToCheck & _
""" AS Expr1, """ & CityToCheck & """ AS Expr2, """ & StateToCheck & """ AS Expr3, """ & _
ZIPToCheck & """ AS Expr4, " & District & " AS Expr5, """ & MatchCode & """ AS Expr6, """ & _
Footnotes & """ AS Expr7;"
DoCmd.SetWarnings True
Next
DoCmd.OpenForm "frmPeopleAddressMaintenance"
Do Until CurrentProject.AllForms("frmPeopleAddressMaintenance").IsLoaded = False
DoEvents
Loop
HomeForm.SetFocus
If IsTableQuery("temptbl") Then dbs.Execute "DROP TABLE temptbl"
End Select
dbs.Close
Exit Sub
ShowMeError:
MsgBox Err.Description, vbOKOnly, "ERROR!"
End Sub
The error occurs in two specific places:
Under the "Case 1": The error happens immediately after...
PassedCongressionalDistrict.Value = CInt(metadata.selectSingleNode("congressional_district").nodeTypedValue)
...is executed. I have debugged this and verified that the statement executed properly and that the value of the "PassedCongressionalDistrict" object is correct.
Then, under "Case Else": The For loop processes the first item list correctly, but fails with the identified error when beginning processing the second item, even though there is good and legitimate data in the second item.
I hope I've explained this well enough. I just can't seem to figure out (1) how to more fully debug this and (2) why the error occurs as it seems that I have all of my object variables defined properly.
Regards,
Ken
It's almost definitely because (on occasion) there is no child node member named "metadata" in the XML body - so when you try to bind your "metadata" object to the .selectSingleNode() method it returns Nothing. You can always check to make sure that it's actually bound...
'// ...start code snippet...
Set metadata = candidate.selectSingleNode("metadata")
If Not metadata is Nothing Then
PassedCongressionalDistrict.Value = CInt(metadata.selectSingleNode("congressional_district").nodeTypedValue)
End If
PassedValidated.Value = True
'// ...end code snippet...