Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
lims_connect
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
pub
lims_connect
Commits
b262cb02
Commit
b262cb02
authored
Aug 26, 2017
by
Johannes Metscher
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add new file
parent
7376c9b9
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
57 additions
and
0 deletions
+57
-0
vba_sample_client/sample.VBScript
vba_sample_client/sample.VBScript
+57
-0
No files found.
vba_sample_client/sample.VBScript
0 → 100644
View file @
b262cb02
' Struktur für XML-HTTP-Response (21.06.2017, SRM)
Public Type tXmlHttpResponse
Status As String
ResponseText As String
ResponseXml As String
ResponseBody As Variant
End Type
' Aufruf von XML-HTTP-Request (21.06.2017, SRM)
Private Function GetXmlHttpResponse(Method As String, _
URL As String, _
Async As Boolean, _
User As String, _
Password As String, _
Message As Variant, _
Optional ContentType As String = "application/json") As tXmlHttpResponse
Dim oXmlHttp As Object
On Error GoTo Catch
' Microsoft XML HTTP Objekt erzeugen
Set oXmlHttp = CreateObject("MSXML2.XMLHTTP")
' Sonderzeichen in URL ersetzen
' URL = Replace(URL, "Ä", "Ä")
' URL = Replace(URL, "ä", "ä")
' URL = Replace(URL, "Ö", "Ö")
' URL = Replace(URL, "ö", "ö")
' URL = Replace(URL, "Ü", "Ü")
' URL = Replace(URL, "ü", "ü")
' Umlaute in HEX-Code von UTF8-Zeichentabelle umwandeln
' Tabelle: siehe http://www.utf8-zeichentabelle.de/
URL = Replace(URL, "Ä", "%C3%84")
URL = Replace(URL, "ä", "%C3%A4")
URL = Replace(URL, "Ö", "%C3%96")
URL = Replace(URL, "ö", "%C3%B6")
URL = Replace(URL, "Ü", "%C3%9C")
URL = Replace(URL, "ü", "%C3%BC")
' Request absetzen
Call oXmlHttp.Open(Method, URL, Async, User, Password)
Call oXmlHttp.setRequestHeader("Content-Type", ContentType)
Call oXmlHttp.setRequestHeader("charset", "UTF-8")
Call oXmlHttp.setRequestHeader("Authorization", "Basic " & gsEncodeBase64(User & ":" & Password))
Call oXmlHttp.Send(Message)
' Rückgabewerte ausgeben
GetXmlHttpResponse.Status = oXmlHttp.Status
GetXmlHttpResponse.ResponseText = oXmlHttp.ResponseText
GetXmlHttpResponse.ResponseXml = oXmlHttp.ResponseXml.Text
GetXmlHttpResponse.ResponseBody = oXmlHttp.ResponseBody
Catch:
If Err.Number <> 0 Then
Call MsgBox(Title:="Fehler beim XML-HTTP-Aufruf", Prompt:=Err.Description, Buttons:=vbExclamation)
End If
End Function
\ No newline at end of file
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment