Wie kann ich mit VBA das Json-Format erstellen und z. B. an PHP senden?
Am einfachsten und schnellsten geht es sicher mit dem JsonConverter von Tim Hall. Die Installation geht schnell und ist hier beschrieben: Json verarbeiten. Auf dieser Basis erfolgt auch die Beschreibung an dieser Stelle.
Die Erklärungen erfolgen am Beispiel der abgegbildeten Tabelle mit IDs, Nachnamen und Vornamen. Im ersten Beispiel werden die Spalten A bis C genutzt, im zweiten A bis D.
Für das Verständnis ist ggf. die Gliederung wichtig: Das kleinste Element ist das Paar aus Key und Value. Mehrere dieser (aber zusammengehörigen) Paare werden in einem Dictionary gesammelt. Verschiedene Dictionaries wiederum werden in einer Collection zusammengefasst. Gibt es davon mehrere, werden die in einem Dictionary gebündelt usw. Am Ende habe wir dann die verschiedenen Elemente der obersten Hierarchieebene; in diesen Beispielen sind das die jsonItems, die dann in Json umgewandelt werden.
Hinweis zur Syntax: Ob eine Zuweisung zu einem Element per Element(Key) = Value oder per Element.Add Key, Value erfolgt, ist hier egal. Im ersten Beispiel wird die erste Variante verwendet, im zweiten die zweite.
Eine Ebene
Im ersten Beispiel wollen wir die drei Zeilen als gleichrangige Elemente, die jeweils aus ID, Namen und (erstem) Vornamen bestehen, in eine Json-Struktur bringen. Dazu lassen wir einfach eine Schleife über die drei Zeilen laufen und erzeugen mit jeder Zeile ein Dictionary, hier jsonDictionary, das aus den drei Elementen id, nachname und vorname besteht. Jedes dieser drei Dictionaries weisen wir der Collection jsonItems zu, so dass diese am Ende aus den drei Dictionaries für die einzelnen Zeilen besteht:
For i = 2 To 4
jsonDictionary("id") = Cells(i, 1)
jsonDictionary("nachname") = Cells(i, 2)
jsonDictionary("vorname") = Cells(i, 3)
jsonItems.Add jsonDictionary
Set jsonDictionary = Nothing
Next i
Nun führen wir zwei Schritte gleichzeitig durch: Wir konvertieren die Collection in das Json-Format und weisen das Ergebnis gleich der Variablen zu, die wir brauchen, um das Ganze per POST an den Server zu schicken. Diese Variable besteht aus einem Key (hier jsonobjekt) und einem Value, der hier der erzeugte Json-Code ist:
strPostDaten = "jsonobjekt=" & JsonConverter.ConvertToJson(jsonItems)
So sieht das dann als String aus, der an den Server geht:
Nun können wir das Ganze losschicken:
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", strURL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send (strPostDaten)
Zur Kontrolle können wir diesen PHP-Code verwenden, der das Json-Objekt in einen Array umwandelt und ausgibt:
$jso = json_decode($_POST['jsonobjekt'], true);
$a = print_r($jso, true);
echo "Anzahl: " . count($jso) . "\n\n" . $a;
Wenn wir dann in VBA .ResponseText ausgeben lassen, sehen wir das Ergebnis, wie es auf dem Server vorliegt:
Hier der gesamte Code zum Testen:
Sub VBA2JSON()
'PHP:
'$jso = json_decode($_POST['jsonobjekt'], true);
'$a = print_r($jso, true);
'echo "Anzahl: " . count($jso) . "\n\n" . $a;
Dim strURL As String, strPostDaten As String
Dim jsonItems As New Collection
Dim jsonDictionary As New Dictionary
Dim i As LongPtr
For i = 2 To 4
jsonDictionary("id") = Cells(i, 1)
jsonDictionary("nachname") = Cells(i, 2)
jsonDictionary("vorname") = Cells(i, 3)
jsonItems.Add jsonDictionary
Set jsonDictionary = Nothing
Next i
strPostDaten = "jsonobjekt=" & JsonConverter.ConvertToJson(jsonItems, 3)
strURL = "https://example.org/vba2json.php"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", strURL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send (strPostDaten)
If .ResponseText <> "" Then
MsgBox .ResponseText
Else
MsgBox "Schiefgegangen.", vbOKOnly + vbCritical, "Fehler"
End If
End With
End Sub
Verschachtelungen, mehrere Ebenen
Das Vorgehen bei mehreren Levels, also Ebenen, ist genau das gleiche. Die Besonderheit besteht nur darin, dass dem Dictionary beim Key=Value-Paar dem Key statt eines z. B. Strings eine Collection zugewiesen wird, also Key=Collection. Dieser Collection werden vorher die einzelnen Dictionary-Einträge mitgegeben, also die Key=Value-Paare der tieferen Ebene.
Wir verwenden das gleiche Beispiel wie vorher, nur dass die jeweils beiden Vornamen gesammelt in einem Array unter "vorname" eine Ebene tiefer sein sollen:
Dafür müssen wir nur die Zeile ändern, in der dem jsonDictionary bisher der Vorname zugewiesen wurde. Dafür legen wir ein neues Dictionary an, hier dicVorname. Dem weisen wir die beiden Key-Value-Paare zu (Hinweis: zum Verdeutlichen wurde hier die .Add-Schreibweise verwendet). Daraus erstellen wir dann die Collection colVornamen. Fertig ist der Value für die erste Ebene, dort weisen wir den dem Dictionary jsonDictionary zum Key vorname zu.
Der Rest bleibt. Mit PHP können wir .ResponseText wieder ansehen:
$jso = json_decode($_POST['jsonobjekt'], true);
$a = print_r($jso, true);
echo $a;
Oder etwas komprimierter, indem wir den Array analysieren:
$jso = json_decode($_POST['jsonobjekt'], true);
foreach ($jso as $key => $value) {
foreach ($value as $key1 => $value1) {
if ($key1 == "vorname") {
$jso1 = $value1;
foreach ($jso1[0] as $key_v => $value_v) {
echo $key . " => " . $key_v . ": " . $value_v . "\n";
}
} else {
echo $key . " => " . $key1 . ": " . $value1 . "\n";
}
}
echo "\n-----------------------------------\n";
}
Der gesamte Code zum Testen:
Sub VBA2JSON_Level()
'PHP:
'$jso = json_decode($_POST['jsonobjekt'], true);
'$a = print_r($jso, true);
'echo $a;
'Oder:
'$jso = json_decode($_POST['jsonobjekt'], true);
'foreach ($jso as $key => $value) {
' foreach ($value as $key1 => $value1) {
'
' if ($key1 == "vorname") {
' $jso1 = $value1;
' foreach ($jso1[0] as $key_v => $value_v) {
' echo $key . " => " . $key_v . ": " . $value_v . "\n";
' }
' } else {
' echo $key . " => " . $key1 . ": " . $value1 . "\n";
' }
'
' }
' echo "\n-----------------------------------\n";
'}
Dim strURL As String, strPostDaten As String
Dim jsonItems As New Collection, colVornamen As New Collection
Dim jsonDictionary As New Dictionary, dicVorname As Dictionary
Dim i As LongPtr
For i = 2 To 4
jsonDictionary.Add "id", Cells(i, 1)
jsonDictionary.Add "nachname", Cells(i, 2)
Set dicVorname = New Dictionary
dicVorname.Add "vorname1", Cells(i, 3)
dicVorname.Add "vorname2", Cells(i, 4)
colVornamen.Add dicVorname
jsonDictionary.Add "vorname", colVornamen
Set colVornamen = Nothing
jsonItems.Add jsonDictionary
Set jsonDictionary = Nothing
Next i
strPostDaten = "jsonobjekt=" & JsonConverter.ConvertToJson(jsonItems)
strURL = "https://example.org/vba2json.php"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", strURL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send (strPostDaten)
If .ResponseText <> "" Then
MsgBox .ResponseText
Else
MsgBox "Schiefgegangen.", vbOKOnly + vbCritical, "Fehler"
End If
End With
End Sub
Download: excel_php_json.xlsm
Suchergebnisse (10 Treffer, 1 Begriff) 
Kategorie: 
Chat
