Hallo
Mein Konzern stellt im Moment auf OpenOffice 3.0.1 um.
Jedoch sind wir auf ein Problem gestoßen.
Eine unserer Anwendungen arbeitet mit Daten der AS400 und diese sollen direkt
in die Textverarbeitung übernommen werden.
Bis dato hat dieses unter Word und Excel einwandfrei Funktioniert.
Für OpenOffice mussten wir unter
Extras/Optionen/"Laden/Speichern"/VBA-Eigenschaften den "Ausführbarer Code"
Button unter Excel aktivieren, womit es anschließend ging.
Unter Word gibt es diesen Button leider nicht und der Import geht auch leider
nicht. Sämtliche andere Optionen sind in diesem Menü aktiv.
Weitere Nachvorschungen ergaben das der Macro Code mittels "REM" auskommentiert
wird.
Ich habe das Macro mal angefügt:
Rem Attribute VBA_ModuleType=VBAModule
Sub AutoOpen
Rem Sub Main()
Rem '' Nur Daten holen, wenn Datei neu
Rem If ThisDocument.Bookmarks.Item("Name1").Range.Text = "" Then
Rem Dim vb
Rem Dim anbnr
Rem Dim sql
Rem
Rem vb = Left(ThisDocument.Name, 4)
Rem anbnr = Mid(ThisDocument.Name, 16, 8)
Rem
Rem sql = ""
Rem sql = sql + "SELECT ORDN50 AS AnbNr,"
Rem sql = sql + " TRIM(OCUO50) AS KBstNr,"
Rem sql = sql + " TRIM(ZORD50) AS KAnfrg,"
Rem sql = sql + " DATE(ORDD50 + 693594) AS VonDat,"
Rem sql = sql + " DATE(ODUE50 + 693594) AS BisDat,"
Rem sql = sql + " OCUS50 AS KundNr,"
Rem sql = sql + " TRIM(IFNULL(TEXT10, K.MNNM10)) AS Name1,"
Rem sql = sql + " TRIM(K.BYNM10) AS Name2,"
Rem sql = sql + " TRIM(K.STRE10) AS Strasse,"
Rem sql = sql + " TRIM(K.ZIPC10) AS PLZ,"
Rem sql = sql + " TRIM(K.ACIT10) AS Ort,"
Rem sql = sql + " (CASE K.CNTY10"
Rem sql = sql + " WHEN 'A' THEN ''"
Rem sql = sql + " ELSE TRIM(TEXTK8) END) AS Land,"
Rem sql = sql + " TRIM(K.PHON10) AS KTel,"
Rem sql = sql + " TRIM(K.TLFA10) AS KFax,"
Rem sql = sql + " IFNULL(TRIM(SUBSTR(KE.EMAIA0, 1, 60)), '') AS
KMail,"
Rem sql = sql + " TRIM(B.MNNM10) AS BetName,"
Rem sql = sql + " TRIM(B.PHON10) AS BetTel,"
Rem sql = sql + " IFNULL(TRIM(SUBSTR(BE.EMAIA0, 1, 60)), '') AS
BetMail,"
Rem sql = sql + " TRIM(V.MNNM10) AS VName,"
Rem sql = sql + " TRIM(V.PHON10) As VTel"
Rem sql = sql + " FROM CASPDTAE.COSPF550"
Rem sql = sql + " JOIN CASPDTAE.GENPF510 AS K"
Rem sql = sql + " ON K.ADRE10 = JADC50"
Rem sql = sql + " LEFT JOIN CASPDTAE.GENPF5A0 AS KE"
Rem sql = sql + " ON KE.MODEA0 = 'A'"
Rem sql = sql + " AND KE.HRKNA0 = ''"
Rem sql = sql + " AND KE.ADTYA0 = ''"
Rem sql = sql + " AND KE.UNRAA0 = K.ADRE10"
Rem sql = sql + " AND KE.POSNA0 = ''"
Rem sql = sql + " AND KE.ADREA0 = ''"
Rem sql = sql + " LEFT JOIN CCMPDTAE.GEFPF510"
Rem sql = sql + " ON ADR110 = K.ADRE10"
Rem sql = sql + " JOIN CASPDTAE.GENPF900"
Rem sql = sql + " ON OINTCT = K.INTC10"
Rem sql = sql + " LEFT JOIN CASPDTAE.GENPFTK8"
Rem sql = sql + " ON LGNTK8 = ''"
Rem sql = sql + " AND TXTPK8 = 'CTY'"
Rem sql = sql + " AND GNKNK8 = ILNDCT"
Rem sql = sql + " AND LNGGK8 = 'D'"
Rem sql = sql + " AND TXTYK8 = ''"
Rem sql = sql + " AND POSNK8 = '0010'"
Rem sql = sql + " LEFT JOIN CASPDTAE.GENPFGPI"
Rem sql = sql + " ON LGENPI = SUBSTR(HRKN50, 1, 2)"
Rem sql = sql + " AND USERPI = IUSE50"
Rem sql = sql + " LEFT JOIN CASPDTAE.GENPF510 AS B"
Rem sql = sql + " ON B.ADRE10 = ADREPI"
Rem sql = sql + " LEFT JOIN CASPDTAE.GENPF5A0 AS BE"
Rem sql = sql + " ON BE.MODEA0 = 'A'"
Rem sql = sql + " AND BE.HRKNA0 = ''"
Rem sql = sql + " AND BE.ADTYA0 = ''"
Rem sql = sql + " AND BE.UNRAA0 = B.ADRE10"
Rem sql = sql + " AND BE.POSNA0 = ''"
Rem sql = sql + " AND BE.ADREA0 = ''"
Rem sql = sql + " LEFT JOIN CASPDTAE.COSPF447"
Rem sql = sql + " ON HRKN47 = HRKN50"
Rem sql = sql + " AND HRKF47 = HRKF50"
Rem sql = sql + " AND OREP47 = OREP50"
Rem sql = sql + " LEFT JOIN CASPDTAE.GENPF510 AS V"
Rem sql = sql + " ON V.ADRE10 = ADRE47"
Rem sql = sql + " WHERE HRKN50 = '" & vb & "'"
Rem sql = sql + " AND HRKF50 = 'J'"
Rem sql = sql + " AND ODMF50 = 'O'"
Rem sql = sql + " AND ORDN50 = '" & anbnr & "'"
Rem
Rem Dim cnn As ADODB.Connection
Rem Dim rst As ADODB.Recordset
Rem Dim cmd As ADODB.Command
Rem
Rem Set cnn = New ADODB.Connection
Rem cnn.Open ("QDSN_10.1.1.12")
Rem
Rem Set cmd = New ADODB.Command
Rem Set cmd.ActiveConnection = cnn
Rem
Rem With cmd
Rem .CommandText = sql
Rem .CommandType = adCmdText
Rem End With
Rem
Rem Set rst = New ADODB.Recordset
Rem Set rst.ActiveConnection = cnn
Rem rst.Open cmd
Rem
Rem If Not rst.EOF Then
Rem Dim rng As Range
Rem With ThisDocument.Bookmarks
Rem '' Kundenanschrift
Rem Set rng = .Item("Name1").Range
Rem rng.Text = rst.Fields("Name1").Value
Rem .Add Name:="Name1", Range:=rng
Rem
Rem Set rng = .Item("Name2").Range
Rem rng.Text = rst.Fields("Name2").Value
Rem .Add Name:="Name2", Range:=rng
Rem
Rem Set rng = .Item("Strasse").Range
Rem rng.Text = rst.Fields("Strasse").Value
Rem .Add Name:="Strasse", Range:=rng
Rem
Rem Set rng = .Item("PLZ").Range
Rem rng.Text = rst.Fields("PLZ").Value
Rem .Add Name:="PLZ", Range:=rng
Rem
Rem Set rng = .Item("Ort").Range
Rem rng.Text = rst.Fields("Ort").Value
Rem .Add Name:="Ort", Range:=rng
Rem
Rem Set rng = .Item("Land").Range
Rem rng.Text = rst.Fields("Land").Value
Rem .Add Name:="Land", Range:=rng
Rem
Rem '' Kunde: Telefon, Fax, E-Mail
Rem Set rng = .Item("KTel").Range
Rem rng.Text = rst.Fields("KTel").Value
Rem .Add Name:="KTel", Range:=rng
Rem
Rem Set rng = .Item("KFax").Range
Rem rng.Text = rst.Fields("KFax").Value
Rem .Add Name:="KFax", Range:=rng
Rem
Rem Set rng = .Item("KMail").Range
Rem rng.Text = rst.Fields("KMail").Value
Rem .Add Name:="KMail", Range:=rng
Rem
Rem '' Betreuungsdaten
Rem Set rng = .Item("BetName").Range
Rem rng.Text = rst.Fields("BetName").Value
Rem .Add Name:="BetName", Range:=rng
Rem
Rem Set rng = .Item("BetTel").Range
Rem rng.Text = rst.Fields("BetTel").Value
Rem .Add Name:="BetTel", Range:=rng
Rem
Rem Set rng = .Item("BetMail").Range
Rem rng.Text = rst.Fields("BetMail").Value
Rem .Add Name:="BetMail", Range:=rng
Rem
Rem Set rng = .Item("VName").Range
Rem rng.Text = rst.Fields("VName").Value
Rem .Add Name:="VName", Range:=rng
Rem
Rem Set rng = .Item("VTel").Range
Rem rng.Text = rst.Fields("VTel").Value
Rem .Add Name:="VTel", Range:=rng
Rem
Rem '' Angebotsdaten
Rem Set rng = .Item("KundNr").Range
Rem rng.Text = rst.Fields("KundNr").Value
Rem .Add Name:="KundNr", Range:=rng
Rem
Rem Set rng = .Item("AnbNr").Range
Rem rng.Text = rst.Fields("AnbNr").Value
Rem .Add Name:="AnbNr", Range:=rng
Rem
Rem Set rng = .Item("VonDat").Range
Rem rng.Text = rst.Fields("VonDat").Value
Rem .Add Name:="VonDat", Range:=rng
Rem
Rem Set rng = .Item("BisDat").Range
Rem rng.Text = rst.Fields("BisDat").Value
Rem .Add Name:="BisDat", Range:=rng
Rem
Rem Set rng = .Item("KBstNr").Range
Rem rng.Text = rst.Fields("KBstNr").Value
Rem .Add Name:="KBstNr", Range:=rng
Rem
Rem Set rng = .Item("KAnfrg").Range
Rem If rst.Fields("KAnfrg").Value <> "" Then
Rem rng.Text = rst.Fields("KAnfrg").Value
Rem Else
Rem rng.Text = "Damen und Herren"
Rem End If
Rem .Add Name:="KAnfrg", Range:=rng
Rem End With
Rem Else
Rem MsgBox ("Auftragsdaten konnten nicht von INFOR übernommen werden!")
Rem End If
Rem '' Benutzerinfo aktualisieren (= alle Felder)
Rem ThisDocument.Fields.Update
Rem End If
Rem End Sub
Rem
End Sub
Die Daten bzw. das Dokument ist neu. Bei Bereits vorhandenen geht es da er es
ja nicht neu Ladet.
Kann man das Auskommentieren irgendwie verhindern bzw. umgehen?
freundliche Grüße/best regards
Martin Kulir
EDV-Organisation
Technik
JAF International Services Ges.m.b.H.
Gerbergasse 2
A-2000 Stockerau
Phone: +43 2266/605-62
Fax: +43 2266/605-185
mailto:[email protected] <mailto:[email protected]>
Internet: http://www.frischeis.at/ <http://www.frischeis.at/>
