Datenschutzerklärung


Direktnachricht



Ihre Software
Details
Excel/VBA 🔍
Add-Ins

Suche in Beispielen und Tipps zu Excel und VBA

Suchbegriff(e) mit Leerzeichen getrennt:

Dateiupload mit Excel und PHPMakro/Sub/Prozedur

Kategorie: Netz ▸ Serverkommunikation

(Tipp 599) Nachricht zum Beitrag an Autor Nach oben

Wie können mit VBA Dateien auf einen Server im Internet geladen werden?

Voraussetzung für dieses Beispiel ist, dass auf dem Server ein eigenes PHP-Script erstellt werden kann, das dann natürlich auch eine Adresse (URL) hat.

In diesem Beispiel sind die hochzuladenden Dateien als Konstanten angegeben:

Private Const strDatei1 As String = "C:\…\test1.jpg" Private Const strDatei2 As String = "C:\…\test2.jpg" Private Const strDatei3 As String = "C:\…\test3.jpg"

Natürlich können die - wie ebenfalls die Script-URL - dem Script auch dynamisch übergeben werden, zum Beispiel als Array. Anpassungen müssen nur an der Sub DateiUpload() vorgenommen werden, der Rest kann so bleiben.

Dies ist der VBA-Code:

Private Const strURL As String = "https://…Ihre URL…/…Ihre PHP-Datei….php" Private Const strDatei1 As String = "C:\…\test1.jpg" Private Const strDatei2 As String = "C:\…\test2.jpg" Private Const strDatei3 As String = "C:\…\test3.jpg" Sub DateiUpload() Dim strPostDaten As String, strBoundary As String strBoundary = "---------------------------7da24f2e50046" strPostDaten = "" strPostDaten = strPostDaten & Header_Datei(strDatei1, strBoundary) strPostDaten = strPostDaten & Header_Datei(strDatei2, strBoundary) strPostDaten = strPostDaten & Header_Datei(strDatei3, strBoundary) strPostDaten = strPostDaten & "--" & strBoundary & "--" With CreateObject("Microsoft.XMLHTTP") .Open "POST", strURL, False .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary .Send SendDaten(strPostDaten) MsgBox .ResponseText End With End Sub Function Header_Datei(strDateiPfad As String, strBoundary As String) Dim strDateiKonv As String, strDateiName As String Header_Datei = "" If strDateiPfad <> "" Then strDateiName = DateiName(strDateiPfad) strDateiKonv = DateiKonv(strDateiPfad) Header_Datei = "--" & strBoundary & vbCrLf & _ "Content-Disposition: form-data; name=""file[]""; filename=""" & strDateiName & """" & vbCrLf & _ "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & strDateiKonv & vbCrLf End If End Function Function DateiName(strpfad As String) DateiName = "" If strpfad <> "" Then DateiName = Mid$(strpfad, InStrRev(strpfad, "\") + 1) End Function Function DateiKonv(strpfad As String) Dim lngDNr As LongPtr, bytBuffer() As Byte DateiKonv = "" lngDNr = FreeFile Open strpfad For Binary Access Read As lngDNr If LOF(lngDNr) > 0 Then ReDim bytBuffer(0 To LOF(lngDNr) - 1) As Byte Get lngDNr, , bytBuffer DateiKonv = StrConv(bytBuffer, vbUnicode) End If Close lngDNr End Function Private Function SendDaten(strText As String) As Byte() SendDaten = StrConv(strText, vbFromUnicode) End Function

Der VBA-Code bereitet die Dateien für den Upload vor, erstellt die richtige Syntax und sendet sie an das PHP-Script:

// Verzeichnis, in dem die Anhänge zwischengespeichert werden: $uploadverz = 'uploadtest/'; // Vorsicht: Ggf. prüfen, ob vorhanden und leer. // File[]-Array sinnvoll sortieren: $dateiarray = array(); foreach($_FILES['file'] as $k1 => $v1) { foreach($v1 as $k2 => $v2) { $dateiarray[$k2][$k1] = $v2; } } // Anhänge speichern, Daten für Versand aufbereiten $a = 0; $ausg = ""; foreach ($dateiarray as $file) { // Ggf. prüfen, ob Dateiname schon im Verzeichnis vorhanden ist und // ggf. umbenennen: $datname = basename($file['name']); // Vorbereitung, falls Dateiname im Verzeichnis existiert: $t = explode(".", $datname); // an Dateiendung splitten $endung = $t[count($t)-1]; $datname_pref = substr($datname, 0, strlen($datname) - strlen($endung) - 1); $uploadpfad = $uploadverz . $datname; // Prüfen, ob Datei existiert: $n = 0; while (file_exists($uploadpfad)) { $n++; $uploadpfad = $uploadverz . $datname_pref . "(" . $n . ")." . $endung; } if (move_uploaded_file($file['tmp_name'], $uploadpfad)) { $a++; $ausg .= $uploadpfad . "\n"; } } // Meldung, die in VBA in der MsgBox als .ResponseText erscheint: echo $a . " Datei(en) erfolgreich hochgeladen." . "\n\n" . $ausg;

Daten per POST an PHP-Script, Response empfangenMakro/Sub/Prozedur

Kategorie: Netz ▸ Serverkommunikation

(Tipp 594) Beispieldatei Nachricht zum Beitrag an Autor Nach oben

Kommunikation mit PHP
Wie kann ich Daten an ein PHP-Script senden oder Daten von dort empfangen?

Dazu gibt es verschiedene Möglichkeiten. Manche haben Nachteile, zum Beispiel Probleme mit UTF-8 oder dass gesendete Daten in den Server-Logs erscheinen.

Empfehlenswert ist das MSXML2.XMLHTTP-Objekt, mit dem per POST Formulardaten ganz einfach gesendet und Antworten empfangen werden können. Die Daten werden einfach als key=value-Kombinationen an die Adresse des Server-Scripts (Beispiel: PHP) übergeben. Ein einfaches Beispiel dazu:

Sub Post_mit_Response() Dim strURL As String, strPostDaten As String strURL = "https://example.org/phptest.php" strPostDaten = "" strPostDaten = strPostDaten & "name=Müller" strPostDaten = strPostDaten & "&vorname=Hans" strPostDaten = strPostDaten & "&strasse=Blumenweg 22" strPostDaten = strPostDaten & "&ort=Musterort" With CreateObject("MSXML2.XMLHTTP") .Open "POST", strURL, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .Send (strPostDaten) If .ResponseText <> "" Then 'Response je nach Anforderung prüfen MsgBox .ResponseText 'Antwort des Servers ausgeben Else MsgBox "Schiefgegangen.", vbOKOnly + vbCritical, "Fehler" End If End With End Sub

Ein Beispiel für ein zugehöriges PHP-Script:

$adresse = "Die Adresse ist:\n\n"; $adresse .= $_POST['vorname'] . " " . $_POST['name'] . "\n"; $adresse .= $_POST['strasse'] . "\n"; $adresse .= $_POST['plz'] . " " . $_POST['ort'] . "\n"; echo $adresse;

In diesem Beispiel würde PHP aus den einzelnen Angaben eine formatierte Adresse gestalten und diese an VBA senden.

Dadurch können u. a. Daten aus Zellen oder Userformen ganz einfach per Mausklick, Tastendruck oder auch per Event an ein Script auf dem Server gesendet werden, das dann die weitere Verarbeitung erledigt. Somit können Mails versendet oder Eintragungen in Datenbanken (z. B. mySQL) vorgenommen werden usw.

Die Antwort des Servers ist hier natürlich nur reiner Text. Für komplexere Vorgänge sollten Sie sich ansehen, was in der Zusammenarbeit von VBA mit JSON möglich ist.

Download: excel_php_json.xlsm

JSON empfangen und verarbeitenMakro/Sub/Prozedur

Kategorien: Netz ▸ Serverkommunikation und Stringoperationen ▸ JSON

(Tipp 597) Beispieldatei Nachricht zum Beitrag an Autor Nach oben

Wie kann ich im Json-Format empfangene Daten mit VBA auswerten?

In Zeiten zunehmender Vernetzung spielt natürlich auch das Json-Format eine große Rolle, zunehmend auch für Excel. Das Senden und Empfangen der Daten ist kein Problem, während die Analyse dieser Daten mit VBA vergleichsweise umständlich ist. Einfache Möglichkeiten, wie beispielsweise mit jQuery, geben die Bordmittel von VBA nicht her.

Wesentlich vereinfacht wird dies jedoch mit dem JsonConverter von Tim Hall, den es hier zum Download gibt: VBA-tools/VBA-JSON. Zur Installation müssen (alles für Windows) nur zwei Schritte erfolgen:

  • Modul JsonConverter.bas in das VBA-Projekt einfügen
  • im Editor unter Extras ▸ Verweise ein Häkchen bei Microsoft Scripting Runtime setzen

Damit steht schon die Funktion JsonConverter.ParseJson() zur Verfügung.

Eine Datenebene

Das Verwenden soll hier zunächst an einem einfachen Beispiel gezeigt werden. Dazu nutzen wir dieses PHP-Script, das einen Adressdatensatz als Json-Objekt zur Verfügung stellt, den wir mit VBA abrufen:

$a['vorname'] = "Max"; $a['nachname'] = "Mütze"; $a['strasse'] = "Mützenweg 55"; $a['plz'] = "01234"; $a['ort'] = "Mützenhausen"; echo json_encode($a);

Zunächst rufen wir das Ganze vom Server ab:

strURL = "https://example.org/jsonabfrage.php" strPostDaten = "" 'Hier käme etwas rein, wenn was an den Server übermittelt werden sollte With CreateObject("MSXML2.XMLHTTP") .Open "POST", strURL, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .Send (strPostDaten)

Damit empfangen wir .ResponseText. Zum Vermeiden von Fehlern durch den JsonConverter ist hier schon wichtig, diese Rückgabe zu prüfen. Im einfachsten Fall mit If InStr(1, .ResponseText, "{") > 0 Then.

In .ResponseText steckt nun dieses Objekt:

Das weisen wir mit der Funktion JsonConverter.ParseJson(.ResponseText) einer Variablen zu, die als Dictionary-Objekt deklariert ist:

Set dicParsed = JsonConverter.ParseJson(.ResponseText)

In der Variablen sind nun die einzelnen Einträge aus dem ResponseText als Key=Value-Paare enthalten. Da die Variable dicParsed ein Objekt ist, verfügt sie über verschiedene Eigenschaften, mit denen wir arbeiten können. So können wir z. B. einfach eine Schleife über die Keys laufen lassen und haben somit deren Werte:

strAusgabe = strAusgabe & dicParsed.Count & " Einträge:" & vbNewLine & vbNewLine For Each varWert In dicParsed.Keys strAusgabe = strAusgabe & varWert & ": " & dicParsed(varWert) & vbNewLine Next varWert MsgBox strAusgabe

Das komplette VBA-Script zum Testen:

Sub Post_JSONAusgabe_1() Dim strURL As String, strPostDaten As String Dim dicParsed As Dictionary Dim varWert As Variant, strAusgabe As String strURL = "https://example.org/jsonabfrage.php" strPostDaten = "" 'Hier käme etwas rein, wenn was an den Server übermittelt werden sollte With CreateObject("MSXML2.XMLHTTP") .Open "POST", strURL, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .Send (strPostDaten) 'Die Antwort muss geprüft werden, da sonst ein Fehler beim JsonConverter auftritt. 'Hier einfach auf das Vorhandensein der geschweiften Klammer: If InStr(1, .ResponseText, "{") > 0 Then strAusgabe = "" Set dicParsed = JsonConverter.ParseJson(.ResponseText) strAusgabe = strAusgabe & dicParsed.Count & " Einträge:" & vbNewLine & vbNewLine For Each varWert In dicParsed.Keys strAusgabe = strAusgabe & varWert & ": " & dicParsed(varWert) & vbNewLine Next varWert MsgBox strAusgabe Else MsgBox "Schiefgegangen: " & .ResponseText, vbOKOnly + vbCritical, "Fehler" End If End With End Sub

 

Mehrere Datenebenen

Häufig haben wir es jedoch mit Verschachtelungen zu tun, dass also in einem Array-Element ein weiterer Array (bzw. in einem Json-Element ein weiteres Json-Objekt) steckt. im vorigen Beispiel waren alle Elemente auf einer Ebene, aber genau so könnten die Elemente insgesamt ein Wert eines übergeordneten Elements sein:

  • values
    • vorname="Max"
    • nachname="Mütze"
    • strasse="Mützenweg 55"
    • plz="01234"
    • ort="Mützenhausen"

Wir hätten hier also den Key „values“, dem als Wert ein weiterer Array, bestehend aus Key-Value-Paaren, zugeordnet ist. Ein Beispiel, wie dies mit PHP möglich wäre:

$a['vorname'] = "Max"; $a['nachname'] = "Mütze"; $a['strasse'] = "Mützenweg 55"; $a['plz'] = "01234"; $a['ort'] = "Mützenhausen"; $b['values'] = $a; echo json_encode($b);

In VBA würde somit dieses Json-Objekt ankommen:

Zum Dekodieren verwenden wir wieder die bekannte Funktion und weisen das Ganze der Dictionary-Variablen zu:

Set dicParsed = JsonConverter.ParseJson(.ResponseText)

Wenn wir nun an die relevanten Inhalte wollen, müssen wir beachten, dass die als Array (bzw. genauer als Dictionary) im übergeordneten Schlüssel „values“ stecken. Das heißt, dass wir den ansprechen müssen. Wir durchlaufen also die einzelnen Elemente in dicParsed("values"):

'Hier werden nur die Einträge aus „values“ verwendet, also das, was in PHP in $a steckt: For Each varWert In dicParsed("values").Keys strAusgabe = strAusgabe & varWert & ": " & dicParsed("values")(varWert) & vbNewLine Next varWert

Hier ist das gesamte Script zum Testen, zum Schluss ergänzt um ein paar Ausgaben zur Verdeutlichung:

Sub Post_JSONAusgabe_2() 'PHP: 'Beachten: Hier gibt es eine Verschachtelung. 'Im Array $a sind die eigentlichen Daten enthalten. '$a['vorname'] = "Max"; '$a['nachname'] = "Mütze"; '$a['strasse'] = "Mützenweg 55"; '$a['plz'] = "01234"; '$a['ort'] = "Mützenhausen"; 'Zuletzt wird $a jedoch dem Array $b zugewiesen, hier dem Key „values“: '$b['values'] = $a; 'Im Json ist also diese Verschachtelung auch enthalten und wird so ausgegeben: 'echo json_encode($b); Dim strURL As String, strPostDaten As String Dim dicParsed As Dictionary Dim varWert As Variant, strAusgabe As String strURL = "https://example.org/jsonabfrage.php" strPostDaten = "" With CreateObject("MSXML2.XMLHTTP") .Open "POST", strURL, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .Send (strPostDaten) If .ResponseText <> "" Then 'Anpassen, auf Fehler prüfen! strAusgabe = "" 'dicParsed ist der komplette(!) verschachtelte Array: Set dicParsed = JsonConverter.ParseJson(.ResponseText) 'Hier werden nur die Einträge aus „values“ verwendet, also das, was in PHP in $a steckt: For Each varWert In dicParsed("values").Keys strAusgabe = strAusgabe & varWert & ": " & dicParsed("values")(varWert) & vbNewLine Next varWert MsgBox "In PHP in $a enthalten:" & vbNewLine & vbNewLine & strAusgabe 'Nun wird der Array um einen Eintrag erweitert (entspräche in PHP $a['alter'] = 32;): 'dicParsed("values")("alter") = 32 dicParsed("values").Add "alter", 32 strAusgabe = "Das gesamte Json-Objekt ist nun:" & vbNewLine & vbNewLine strAusgabe = strAusgabe & JsonConverter.ConvertToJson(dicParsed) 'komplettes Json-Objekt strAusgabe = strAusgabe & vbNewLine & vbNewLine strAusgabe = strAusgabe & "während im Key „values“ (ehemals $b) nur das enthalten ist:" & vbNewLine & vbNewLine strAusgabe = strAusgabe & JsonConverter.ConvertToJson(dicParsed("values")) 'Inhalt nur von "values" MsgBox strAusgabe Else MsgBox "Schiefgegangen.", vbOKOnly + vbCritical, "Fehler" End If End With End Sub

Download: excel_php_json.xlsm

JSON mit VBA erstellen und an den Server schickenMakro/Sub/Prozedur

Kategorien: Netz ▸ Serverkommunikation und Stringoperationen ▸ JSON

(Tipp 598) Beispieldatei Nachricht zum Beitrag an Autor Nach oben

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

Mails mit VBA und PHP versenden (mehrere Empfänger, mehrere Anhänge)Makro/Sub/ProzedurTipp

Kategorien: Netz ▸ Serverkommunikation und Netz ▸ Mail

(Tipp 600) Nachricht zum Beitrag an Autor Nach oben

Wie können mit VBA Mails mit mehreren Dateianhängen an mehrere Empfänger gesendet werden?

Die Aufgabenstellung, per Mausklick oder automatisiert Mails zu versenden, ist sehr weit verbreitet. Es gibt auch viele Tipps, wie das mit Outlook erfolgen kann. Jedoch gibt es immer wieder Probleme, sei es durch Rechtebeschränkungen, wegzuklickende Meldungen von Outlook usw.

Am sinnvollsten ist deshalb eine Lösung, mit der man weitestgehend unabhängig von Officeprogrammen ist. Hier besteht die Möglichkeit, VBA nur zum Versand der Maildaten an einen Server zu benötigen, der dann den Rest des Erstellens und Versands der Mail übernimmt.

Voraussetzung für dieses Beispiel ist, dass auf dem Server ein eigenes PHP-Script erstellt werden kann, das dann natürlich auch eine Adresse (URL) hat.

Basis ist der Beitrag Dateiupload. Der VBA-Code dazu wurde hier um die Möglichkeit, Text zu versenden, erweitert. Prinzipiell trifft hier aber das Gleiche zu - vor allem, dass die oben verwendeten Konstanten auch dynamisch verwendet werden können. Hier wird nur das Prinzip aufgezeigt, die Anpassungen müssen dann entsprechend der eigenen Gegebenheiten erfolgen. Dies betrifft insbesondere auch die Sicherheit. Denken Sie daran, die manuell zu ändernden Daten vorher zu prüfen. Diese Scripte sind auch leicht zum Versand von Massenspam zu verwenden.

Dies ist der VBA-Code, der um die Text-Funktion erweitert wurde:

Private Const strURL As String = "https://…Ihre URL…/…Ihre PHP-Datei….php" Private Const strDatei1 As String = "C:\…\test1.jpg" Private Const strDatei2 As String = "C:\…\test2.jpg" Private Const strDatei3 As String = "C:\…\test3.jpg" Private Const strMailEmpfaenger As String = "info1@example.org;info2@example.org;info3@example.org" Private Const strAbsText As String = "Max Mütze" Private Const strAbsMail As String = "xyz@example.org" Private Const strBoundary As String = "---------------------------7da24f2e50046" Sub DateiUploadUndMail() Dim strPostDaten As String strPostDaten = "" strPostDaten = strPostDaten & Header_Text("empfaenger", strMailEmpfaenger, "text/plain", strBoundary) strPostDaten = strPostDaten & Header_Text("abstext", strAbsText, "text/plain", strBoundary) strPostDaten = strPostDaten & Header_Text("absmail", strAbsMail, "text/plain", strBoundary) strPostDaten = strPostDaten & Header_Text("betreff", "Das ist der Betreff.", "text/plain", strBoundary) strPostDaten = strPostDaten & Header_Text("mailtext", "Hallo!" & vbNewLine & vbNewLine & "Ich bin der Mailtext.", "text/html", strBoundary) strPostDaten = strPostDaten & Header_Datei(strDatei1, strBoundary) strPostDaten = strPostDaten & Header_Datei(strDatei2, strBoundary) strPostDaten = strPostDaten & Header_Datei(strDatei3, strBoundary) strPostDaten = strPostDaten & "--" & strBoundary & "--" With CreateObject("Microsoft.XMLHTTP") .Open "POST", strURL, False .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary .Send SendDaten(strPostDaten) MsgBox .ResponseText End With End Sub Function Header_Text(strKey As String, strValue As String, strMime As String, strBoundary) Header_Text = "--" & strBoundary & vbCrLf & _ "Content-Disposition: form-data; name=""" & strKey & """;" & vbCrLf & _ "Content-Type: " & strMime & "; charset=UTF-8" & vbCrLf & vbCrLf & strValue & vbCrLf End Function Function Header_Datei(strDateiPfad As String, strBoundary As String) Dim strDateiKonv As String, strDateiName As String Header_Datei = "" If strDateiPfad <> "" Then strDateiName = DateiName(strDateiPfad) strDateiKonv = DateiKonv(strDateiPfad) Header_Datei = "--" & strBoundary & vbCrLf & _ "Content-Disposition: form-data; name=""file[]""; filename=""" & strDateiName & """" & vbCrLf & _ "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & strDateiKonv & vbCrLf End If End Function Function DateiName(strpfad As String) DateiName = "" If strpfad <> "" Then DateiName = Mid$(strpfad, InStrRev(strpfad, "\") + 1) End Function Function DateiKonv(strpfad As String) Dim lngDNr As LongPtr, bytBuffer() As Byte DateiKonv = "" lngDNr = FreeFile Open strpfad For Binary Access Read As lngDNr If LOF(lngDNr) > 0 Then ReDim bytBuffer(0 To LOF(lngDNr) - 1) As Byte Get lngDNr, , bytBuffer DateiKonv = StrConv(bytBuffer, vbUnicode) End If Close lngDNr End Function Private Function SendDaten(strText As String) As Byte() SendDaten = StrConv(strText, vbFromUnicode) End Function

Damit werden die Daten an das PHP-Script gesendet, das diese empfängt und daraus die Mails erstellt sowie diese versendet. Auch hier unbedingt daran denken, die Daten noch auf Gültigkeit zu prüfen!

Das komplette PHP-Script:

/* Wichtig: Da das Script prinzipiell auch zu Versand von Massenspam geeignet ist, sollten ganz am Anfang noch Kennwort und Nutzername (oder eine andere Absicherung) abgefragt werden. Diese Angaben können von VBA aus ganz einfach als POST-Paare mitgeschickt werden. */ // Verzeichnis, in dem die Anhänge zwischengespeichert werden: $anhangverz = 'uploadtest/'; // Vorsicht: Ggf. prüfen, ob vorhanden und leer. // Mailadressen durch Semikolon getrennt $empfstrings = $_POST['empfaenger']; // Text, der als Absender erscheint: $abstext = $_POST['abstext']; // Mailadresse des Absenders: $absmail = $_POST['absmail']; $betreff = utf8_encode($_POST['betreff']); $mailtext = utf8_encode($_POST['mailtext']); // File[]-Array sinnvoll sortieren: $dateiarray = array(); foreach($_FILES['file'] as $k1 => $v1) { foreach($v1 as $k2 => $v2) { $dateiarray[$k2][$k1] = $v2; } } // Anhänge speichern, Daten für Versand aufbereiten $anhangarray = array(); $a = 0; foreach ($dateiarray as $file) { // Ggf. prüfen, ob Dateiname schon im Verzeichnis vorhanden ist und // ggf. umbenennen: $datname = basename($file['name']); $uploadpfad = $anhangverz . $datname; if (move_uploaded_file($file['tmp_name'], $uploadpfad)) { $a++; $anhangarray[$a]['pfad'] = $uploadpfad; $anhangarray[$a]['dateiname'] = $datname; $anhangarray[$a]['groesse'] = filesize($uploadpfad); $dateiinhalt = fread(fopen($uploadpfad, "r"), filesize($uploadpfad)); $anhangarray[$a]['data'] = chunk_split(base64_encode($dateiinhalt)); } } $empf_array = explode(";",$empfstrings); $encoding = mb_detect_encoding($mailtext, "utf-8, iso-8859-1, cp-1252"); $mime_boundary = "-----=" . md5(uniqid(microtime(), true)); $versendet = 0; // Mail an jeden Empfänger schicken: foreach($empf_array as $einzelmail) { if (trim($einzelmail) != "") { $header ="From:" . $abstext . "<" . $absmail . ">\n"; $header.= "MIME-Version: 1.0\r\n"; $header.= "Content-Type: multipart/mixed;\r\n"; $header.= " boundary=\"" . $mime_boundary . "\"\r\n"; $content = "This is a multi-part message in MIME format.\r\n\r\n"; $content.= "--".$mime_boundary."\r\n"; $content.= "Content-Type: text/plain; charset=\"$encoding\"\r\n"; $content.= "Content-Transfer-Encoding: 8bit\r\n\r\n"; $content.= $mailtext . "\r\n"; if ($a > 0) { // Ggf. Mailanhänge anfügen for ( $n = 1; $n <= $a; $n++) { $content.= "--" . $mime_boundary . "\r\n"; $content.= "Content-Disposition: attachment;\r\n"; $content.= "\tfilename=\"" . $anhangarray[$n]['dateiname'] . "\";\r\n"; $content.= "Content-Length: " . $anhangarray[$n]['groesse'] . ";\r\n"; $content.= "Content-Type: application/pdf; name=\"" . $anhangarray[$n]['dateiname'] . "\"\r\n"; $content.= "Content-Transfer-Encoding: base64\r\n\r\n"; $content.= $anhangarray[$n]['data'] . "\r\n"; } } $content .= "--" . $mime_boundary . "--"; if (mail($einzelmail, $betreff, $content, $header)) { $versendet++; } } } // Ggf. Mailanhänge löschen if ($a > 0) { for ( $n = 1; $n <= $a; $n++) { if ($anhangarray[$n]['pfad'] != "") {unlink($anhangarray[$n]['pfad']);} } } // Meldung, die in VBA in der MsgBox als .ResponseText erscheint: echo $versendet . " Mail(s) erfolgreich gesendet.";

Textzahl zu ZahlMakro/Sub/ProzedurTipp

Kategorien: Format ▸ Text und Tabelle ▸ Zellen

(Tipp 65) Nachricht zum Beitrag an Autor Nach oben

Manchmal stehen Zahlen nach dem Import aus anderen Programmen links in der Zelle und werden auch nicht als Zahl interpretiert. Wie kann man das ändern?

Es ist das Problem, das häufig auftritt, wenn die Daten aus Textdateien oder aus dem Internet kommen. Dann sind scheinbar Zahlen enthalten, die aber in den Zellen links stehen - ein Indiz dafür, dass die Daten nicht als Zahlen, sondern als Texte (String) erkannt wurden. Man kann natürlich die Zellen rechtsbündig formatieren, was aber das grundlegende Problem nicht löst. Da es sich immer noch um Texte handelt, können bei Berechnungen Fehler auftreten.

Nun könnte man nacheinander jede Zelle aktivieren, mit F2 den Eingabemodus aufrufen und gleich wieder Enter drücken. Dadurch würde Excel i. d. R. die Zahlen als solche erkennen. Bei sehr vielen Zellen dürfte das aber eine zeitraubende Angelegenheit sein.

Hier ist ein Beispiel, das für die Lösung den Excel-internen Befehl Inhalte einfügen - Multiplikation verwendet. Nehmen wir an, in A1 steht die Ziffer 1. Dann kann man die Textzahlen in B1:B21 umwandeln mit:

Range("A1").Copy Range("B1:B21").PasteSpecial Operation:=xlMultiply, SkipBlanks:=True

Sind Hochkommas im Spiel, sehen Sie sich bitte Hochkomma (') entfernen an.



WWW-Adressen in HTML-Links umwandeln (VBA + Formel)Makro/Sub/ProzedurFormellösung

Kategorien: Netz ▸ HTML und Stringoperationen ▸ Verketten

(Tipp 362) Nachricht zum Beitrag an Autor Nach oben

In einer Spalte habe ich Beschriftungen, in einer anderen Internetadressen. Wie kann ich HTML-Links daraus etrstellen?

In Spalte A stehen ab Zeile 1 die Linkbezeichnungen, also das, was als Text erscheint. In Spalte B stehen die Adressen (URLs).


Formel

="<a href="&ZEICHEN(34)&B1&ZEICHEN(34)&">"&A1&"</a>"


VBA

Die Routine erstellt die Links (<a href), speichert sie in einer Textdatei und ruft diese im Editor auf:

Sub In_Link_konvertieren() Dim lngDNr As LongPtr, lngZ As LongPtr, strLink As String, strPfad As String strPfad = "c:\eigene dateien\temp\test.txt" 'Datei mit HTML-Code lngZ = 1 'erste Zeile mit Angaben lngDNr = FreeFile Open strPfad For Output As #lngDNr Do While Cells(lngZ, 1) <> "" 'Schleife, solange die nächste Zelle nicht leer ist 'Übernehmen der Daten in die Textdatei strLink = "<a href=" & Chr(34) & Cells(lngZ, 2) & Chr(34) & ">" & Cells(lngZ, 1) & "</a>" Print #lngDNr, strLink lngZ = lngZ + 1 Loop Close #lngDNr Shell "notepad.exe " & strPfad & "", vbMaximizedFocus End Sub