Hallo Malte,
das du den Tabellennamen anpassen musst, sollte eigentlich klar sein.
Die Variable "supplier_specific" ist nicht deklariert!
' **********************************************************************
' Modul: kursnet_xml_name Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub kursnet_xml()
Dim Datei As String, Text As String
Dim Zeile As Long
Dim zeigen
On Error GoTo Hell
'Zieldatei festlegen
Datei = ThisWorkbook.Path & "\test.xml"
Open Datei For Output As #1 'Zieldatei öffnen
'reinschreiben
Print #1, "<?xml version=""1.1"" encoding=""iso-8859-15"" standalone=""yes""?>"
Print #1, "<OPENQCAT version=""1.1"" xsi:noNamespaceSchemaLocation=""openQ-cat.V1.1.xsd"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">"
Print #1, "<HEADER>"
Print #1, "<GENERATOR_INFO>Export OpenQ 3.10.0</GENERATOR_INFO>"
Print #1, "<CATALOG>"
Print #1, "<LANGUAGE>deu</LANGUAGE>"
Print #1, "<CATALOG_ID>170281-1424116599866</CATALOG_ID>"
Print #1, "<CATALOG_VERSION>Vers_KURSNET</CATALOG_VERSION>"
Print #1, "<CATALOG_NAME>KURSNET-Export</CATALOG_NAME>"
Print #1, "</CATALOG>"
Print #1, "<DOCUMENT_CREATOR>"
Print #1, "<FIRST_NAME>Malte</FIRST_NAME>"
Print #1, "<LAST_NAME>Krohn</LAST_NAME>"
Print #1, "<PHONE>+49.6221.650330</PHONE>"
Print #1, "<ID_DB>nr:9866</ID_DB>"
Print #1, "<ADDRESS>"
Print #1, "<NAME>AH Akademie für Fortbildung Heidelberg GmbH</NAME>"
Print #1, "<STREET>Maaßstr. 28</STREET>"
Print #1, "<ZIP>69123</ZIP>"
Print #1, "<CITY>Heidelberg</CITY>"
Print #1, "<COUNTRY>DE</COUNTRY>"
Print #1, "<URL>http://www.akademie-heidelberg.de</URL>"
Print #1, "<ID_DB>adr:699</ID_DB>"
Print #1, "</ADDRESS>"
Print #1, "<CONTACT_REMARKS>Eugen Riske</CONTACT_REMARKS>"
Print #1, "</DOCUMENT_CREATOR>"
Print #1, "<RECIPIENT>"
Print #1, "<RECIPIENT_ID>BA</RECIPIENT_ID>"
Print #1, "<RECIPIENT_NAME>Informationssystem KURSNET</RECIPIENT_NAME>"
Print #1, "<ADDRESS>"
Print #1, "<NAME>IT-Systemhaus</NAME>"
Print #1, "<STREET>Regensburgerstr. 104</STREET>"
Print #1, "<ZIP>90478</ZIP>"
Print #1, "<CITY>Nürnberg</CITY>"
Print #1, "<COUNTRY>DE</COUNTRY>"
Print #1, "<URL>http://www.kursnet-online.arbeitsagentur.de</URL>"
Print #1, "</ADDRESS>"
Print #1, "</RECIPIENT>"
Print #1, "<SUPPLIER>"
Print #1, "<SUPPLIER_ID type=""supplier_specific"">170281</SUPPLIER_ID>"
Print #1, "<SUPPLIER_NAME>Akademie Heidelberg AH Akademie für Fortbildung Heidelberg GmbH</SUPPLIER_NAME>"
Print #1, "<ADDRESS>"
Print #1, "<NAME>Akademie Heidelberg</NAME>"
Print #1, "<NAME2>AH Akademie für Fortbildung</NAME2>"
Print #1, "<NAME3>Heidelberg GmbH</NAME3>"
Print #1, "<STREET>Maaßstr. 28</STREET>"
Print #1, "<ZIP>69123</ZIP>"
Print #1, "<BOXNO>101105</BOXNO>"
Print #1, "<ZIPBOX>69001</ZIPBOX>"
Print #1, "<CITY>Heidelberg</CITY>"
Print #1, "<STATE>Baden-Württemberg</STATE>"
Print #1, "COUNTRY>Deutschland</COUNTRY>"
Print #1, "<PHONE>+49.6221.650330</PHONE>"
Print #1, "<MOBILE/>"
Print #1, "<FAX/>"
Print #1, "<EMAILS>"
Print #1, "EMAIL>info@akademie-heidelberg.de</EMAIL>"
Print #1, "</EMAILS>"
Print #1, "<URL>http://www.akademie-heidelberg.de</URL>"
Print #1, "</ADDRESS>"
Print #1, "<CONTACT>"
Print #1, "<CONTACT_ROLE type="; 5; ">Sonstige</CONTACT_ROLE>"
Print #1, "<SALUTATION>m</SALUTATION>"
Print #1, "<FIRST_NAME>Krohn</FIRST_NAME>"
Print #1, "<LAST_NAME>Malte</LAST_NAME>"
Print #1, "<PHONE>+49.160.96210866</PHONE>"
Print #1, "<MOBILE/>"
Print #1, "<FAX/>"
Print #1, "<EMAILS>"
Print #1, "<EMAIL>malte.krohn@akademie-heidelberg.de</EMAIL>"
Print #1, "</EMAILS>"
Print #1, "<URL>"
Print #1, "http://www.akademie-heidelberg.de</URL>"
Print #1, "<ID_DB>921272</ID_DB>"
Print #1, "<CONTACT_REMARKS>Home-Office</CONTACT_REMARKS>"
Print #1, "</CONTACT>"
Print #1, "<KEYWORD>Fortbildung</KEYWORD>"
Print #1, "<KEYWORD>Heidelberg</KEYWORD>"
Print #1, "<KEYWORD>Akademie Heidelberg AH Akademie für Fortbildung Heidelberg GmbH</KEYWORD>"
Print #1, "<KEYWORD>GmbH</KEYWORD>"
Print #1, "<KEYWORD>Akademie</KEYWORD>"
Print #1, "<EXTENDED_INFO input_type=""0"">"
Print #1, "<ORGANIZATIONAL_FORM type=""2"">Private Bildungseinrichtung</ORGANIZATIONAL_FORM>"
Print #1, "</EXTENDED_INFO>"
Print #1, "</SUPPLIER>"
Print #1, "</HEADER>"
Print #1, "<NEW_CATALOG FULLCATALOG=""false"">"
'Seminardaten aus kursnet-Tabelle nehmen
'mit Schleife die ersten 5 Zeilen der Tabelle reinschreiben
'Spalte A = Blz, Spalte B = Institut
'For Zeile = 2 To 2
With Sheets("kursnet_xml")
For Zeile = 2 To Application.Max(2, .Cells(.Rows.Count, 3).End(xlUp).Row)
Print #1, "<SERVICE mode=""new"">"
Print #1, "<PRODUCT_ID>" & .Cells(Zeile, 2).Text & "</PRODUCT_ID>"
Print #1, "<SUPPLIER_ID_REF type="; supplier_specific; ">170281</SUPPLIER_ID_REF>"
Print #1, "<SERVICE_DETAILS>"
Print #1, "<TITLE>" & .Cells(Zeile, 4).Text & "</TITLE>"
Print #1, "<DESCRIPTION_LONG>" & .Cells(Zeile, 5).Text & "</DESCRIPTION_LONG>"
Print #1, "<SUPPLIER_ALT_PID>" & .Cells(Zeile, 6).Text & "</SUPPLIER_ALT_PID>"
Print #1, "<CONTACT>"
Print #1, "<CONTACT_ROLE type="; 1; ">Ansprechpartner</CONTACT_ROLE>"
Print #1, "<SALUTATION>" & .Cells(Zeile, 9).Text & "</SALUTATION>"
Print #1, "<FIRST_NAME>" & .Cells(Zeile, 10).Text & "</FIRST_NAME>"
Print #1, "<LAST_NAME>" & .Cells(Zeile, 11).Text & "</LAST_NAME>"
Print #1, "<PHONE>" & .Cells(Zeile, 12).Text & "</PHONE>"
Print #1, "<MOBILE>" & .Cells(Zeile, 13).Text & "</MOBILE>"
Print #1, "<FAX>" & .Cells(Zeile, 14).Text & "</FAX>"
Print #1, "<EMAILS>"
Print #1, "<EMAIL>" & .Cells(Zeile, 15).Text & "</EMAIL>"
Print #1, "</EMAILS>"
Print #1, "<URL>http://www.akademie-heidelberg.de</URL>"
Print #1, "<ID_DB>" & .Cells(Zeile, 16).Text & "</ID_DB>"
Print #1, "</CONTACT>"
Print #1, "<SERVICE_DATE>"
Print #1, "<START_DATE>" & .Cells(Zeile, 17).Text & "T00:00:00+01:00</START_DATE>"
Print #1, "<END_DATE>" & .Cells(Zeile, 18).Text & "T00:00:00+01:00</END_DATE>"
Print #1, "</SERVICE_DATE>"
Print #1, "<KEYWORD>" & .Cells(Zeile, 41).Text & "</KEYWORD>"
Print #1, "<TARGET_GROUP>"
Print #1, "<TARGET_GROUP_TEXT>" & .Cells(Zeile, 19).Text & "</TARGET_GROUP_TEXT>"
Print #1, "</TARGET_GROUP>"
Print #1, "<TERMS_AND_CONDITIONS/>"
Print #1, "<SERVICE_MODULE>"
Print #1, "<EDUCATION type=""true"">"
Print #1, "<COURSE_ID>16997352</COURSE_ID>"
Print #1, "<DEGREE type=""0"">"
Print #1, "<DEGREE_TITLE>Keine Angabe zur Abschlussbezeichnung</DEGREE_TITLE>"
Print #1, "<DEGREE_EXAM type=""Zertifikat"">"
Print #1, "<EXAMINER>Keine Angabe</EXAMINER>"
Print #1, "</DEGREE_EXAM>"
Print #1, "<DEGREE_ADD_QUALIFICATION>Keine Angabe</DEGREE_ADD_QUALIFICATION>"
Print #1, "<DEGREE_ENTITLED>Keine Angabe</DEGREE_ENTITLED>"
Print #1, "</DEGREE>"
Print #1, "<SUBSIDY/>"
Print #1, "<EXTENDED_INFO>"
Print #1, "<INSTITUTION type=""105"">" & "Einrichtung der beruflichen Weiterbildung" & "</INSTITUTION>"
Print #1, "<INSTRUCTION_FORM type=""1"">" & "Vollzeit" & "</INSTRUCTION_FORM>"
Print #1, "<EDUCATION_TYPE type=""104"">" & "Fortbildung/Qualifizierung" & "</EDUCATION_TYPE>"
Print #1, "</EXTENDED_INFO>"
Print #1, "<MODULE_COURSE>"
Print #1, "<LOCATION>"
Print #1, "<NAME>" & .Cells(Zeile, 20).Text & "</NAME>"
Print #1, "<STREET>" & .Cells(Zeile, 21).Text & "</STREET>"
Print #1, "<ZIP>" & .Cells(Zeile, 22).Text & "</ZIP>"
Print #1, "<ZIPBOX>" & .Cells(Zeile, 23).Text & "</ZIPBOX>"
Print #1, "<CITY>" & .Cells(Zeile, 24).Text & "</CITY>"
Print #1, "<STATE>" & .Cells(Zeile, 25).Text & "</STATE>"
Print #1, "<COUNTRY>" & .Cells(Zeile, 26).Text & "</COUNTRY>"
Print #1, "<PHONE/>"
Print #1, "<MOBILE/>"
Print #1, "<FAX/>"
Print #1, "</LOCATION>"
Print #1, "<DURATION type=""1""/>"
Print #1, "<FLEXIBLE_START>false</FLEXIBLE_START>"
Print #1, "<EXTENDED_INFO>"
Print #1, "<SEGMENT_TYPE type=""0""/>"
Print #1, "</EXTENDED_INFO>"
Print #1, "</MODULE_COURSE>"
Print #1, "</EDUCATION>"
Print #1, "</SERVICE_MODULE>"
Print #1, "<ANNOUNCEMENT>"
Print #1, "<START_DATE>" & .Cells(Zeile, 29).Text & "+01:00</START_DATE>"
Print #1, "<END_DATE>" & .Cells(Zeile, 30).Text & "+02:00</END_DATE>"
Print #1, "</ANNOUNCEMENT>"
Print #1, "</SERVICE_DETAILS>"
Print #1, "<SERVICE_CLASSIFICATION>"
Print #1, "<REFERENCE_CLASSIFICATION_SYSTEM_NAME>Kurssystematik</REFERENCE_CLASSIFICATION_SYSTEM_NAME>"
Print #1, "<FEATURE>"
Print #1, "<FNAME>" & .Cells(Zeile, 32).Text & "</FNAME>"
Print #1, "<FVALUE>" & .Cells(Zeile, 33).Text & "</FVALUE>"
Print #1, "</FEATURE>"
Print #1, "</SERVICE_CLASSIFICATION>"
Print #1, "<SERVICE_PRICE_DETAILS>"
Print #1, "<SERVICE_PRICE>"
Print #1, "<PRICE_AMOUNT>"; .Cells(Zeile, 34) & "</PRICE_AMOUNT>"
Print #1, "<PRICE_CURRENCY>EUR</PRICE_CURRENCY>"
Print #1, "</SERVICE_PRICE>"
Print #1, "<REMARKS>zzgl. gesetzl. USt.</REMARKS>"
Print #1, "</SERVICE_PRICE_DETAILS>"
Print #1, "<MIME_INFO>"
Print #1, "<MIME_ELEMENT>"
Print #1, "<MIME_SOURCE>" & .Cells(Zeile, 35) & "</MIME_SOURCE>"
Print #1, "</MIME_ELEMENT>"
Print #1, "</MIME_INFO>"
Print #1, "</SERVICE>"
Next Zeile
End With
Print #1, "</NEW_CATALOG>"
Print #1, "</OPENQCAT>"
Close #1 'Zieldatei schließen
zeigen = Shell(Environ("windir") & "\notepad.exe " & Datei, 1)
Exit Sub
Hell:
Close #1
MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, "Fehler"
End Sub
Gruß Sepp