Hallo noch mal,
für Ulli und alle anderen Interessenten hier mein Verfahren mit einer
Access-Datenbank. Die Beschreibung ist so ausführlich, dass sie auch mir
als Dokumentation meiner Datenbank hilft. Sowas kommt ja sowieso immer
zu kurz :-)
Am 06.09.2015 um 08:21 schrieb Ulrich Cichy:
>> Wer Interesse an dieser Lösung hat, kann das ja ebenfalls hier kund tun.
> ....
>
> Auch gilt für mich: ja, gern. Würde mich schon interessieren.
>
1. Export *aller* Kurse aus QC in eine Textdatei "accdb.txt".
Format übrigens "CSV-mäßig"
[&Date.Day].[&Date.Month].[&Date.Year];[&CountryCode]:[&WKN];[&Quote.Int],[&Quote.Frac];[&Currency]
ein Datensatz je Zeile -- die Datenbank braucht den anderen Ballast ja
nicht.
2. Verknüpfen diverser Tabellen der MNY-Datei mit Access
"Externe Daten", Access, Dateiname ist die *.mny-Datei. Wir brauchen
CRNC, SEC und SP, die wir unter demselben Namen *verknüpfen* (nicht
importieren!)
3. Einlesen der QC-Textdatei in die Access-DB, sofern die Kurse nicht
schon drin
sind:
- In Access eine Verknüpfung zur accdb.txt herstellen unter dem Namen
"1_QCKurseTxt".
- Feldtrenner ist das Semikolon, so werden 4 Felder erkannt.
- Access Tabelle "1_QCKurseTbl" anlegen mit 6 Feldern:
* QCID Primärschlüssel (Autowert)
* hsec Long Integer
* QCDatum Datum(kurz)
* QCWKN Text (20 Zeichen)
* QCQuote Double
* QCQurrency Text (3 Zeichen)
Bei allen 5 Feldern (außer QCID) ist die Eingabe erforderlich.
hsec, QCDatum und QCWKN sind außerdem indiziert (Duplikate möglich).
Schließlich habe ich noch einen kombinierten EINDEUTIGEN Index auf
QCDatum und QCWKN gelegt, damit definitiv je Wertpapier und Tag nur 1
Kurs vorkommen kann.
- Mit diesen Vorbereitungen kann ich die Textdatei mit diesem
SQL-Statement einlesen (Copy&Paste in die SQL-Ansicht einer neuen,
leeren Abfrage):
INSERT INTO 1_QCKurseTbl
(
QCDatum,
QCWKN,
QCQuote,
QCCurrency,
hsec )
SELECT [1_QCKurseTxt].Feld1,
[1_QCKurseTxt].Feld2,
[1_QCKurseTxt].Feld3,
[1_QCKurseTxt].Feld4,
SEC.hsec
FROM 1_QCKurseTxt
INNER JOIN SEC
ON [1_QCKurseTxt].Feld2 = SEC.szSymbol;
Abspeichern als "10_QCKurseAppend".
Diese Anfügeabfrage kann man immer wieder ausführen. Durch den
kombinierten Index wird verhindert, dass Kurse doppelt eingelesen
werden. Es kommt dann ein Hinweis von Access, dass diverse Datensätze
wegen Schlüsselverletzung nicht eingefügt wurden -- das ist ok.
Wenn mit QC die Exportdatei wieder erstellt wird, um neue
Kursinformationen zu transferieren, kann man einfach wieder "alles"
exportieren und hier einlesen, nur das wirklich neue landet zusätzlich
in der Tabelle.
4. Abgleich, welche Kurse in der mny-Datei fehlen oder stark abweichen
Ich will nicht einfach "blind" die Daten aus QC nach Money überspielen.
Money "verträgt", soweit ich das verstehe, nur einen Kurs pro Tag. Ich
gleiche regelmäßig am Jahresende die Kurse manuell mit meinen
Depotauszügen ab. Diese Info will ich nicht überschrieben. Auch gibt es
häufig vom "online"-Kurs abweichende Kauf- oder Verkaufskurse des
gleichen Tages, auch die will ich behalten. Letztlich scheint es auch
Rundungsdifferenzen beim Einlesen oder Abspeichern der Kurse zu geben,
so dass ich nur per QWB einspielen will, was fehlt oder deutlich (>2%)
abweicht.
Aufpassen muss man schließlich noch, dass die Währung in QC und Money
identisch ist.
Mit all diesen Bedingungen ergibt sich diese Abfrage "11_QCKurseExist",
die also die *existierenden* Datensätze indentifiziert:
SELECT [1_QCKurseTbl].QCID,
[1_QCKurseTbl].hsec,
[1_QCKurseTbl].QCDatum,
[1_QCKurseTbl].QCWKN,
[1_QCKurseTbl].QCQuote,
SP.dPrice,
SP.src,
MONTH([1_QCKurseTbl.QCDatum]) AS Monat,
DAY([1_QCKurseTbl.QCDatum]) AS Tag,
CRNC.szIsoCode,
ABS([QCQuote]-[dPrice])/[dPrice] AS Abw
FROM (CRNC
INNER JOIN SEC
ON CRNC.hcrnc = SEC.hcrnc)
INNER JOIN (1_QCKurseTbl
INNER JOIN SP
ON ([1_QCKurseTbl].QCDatum = SP.dt)
AND ([1_QCKurseTbl].hsec = SP.hsec))
ON SEC.hsec = SP.hsec
WHERE (((ABS([QCQuote]-[dPrice])/[dPrice])<0.02))
OR (((SP.src) <>6))
OR (((MONTH([1_QCKurseTbl.QCDatum])) =12)
AND ((DAY([1_QCKurseTbl.QCDatum])) =30
OR (DAY([1_QCKurseTbl.QCDatum])) =31));
(Wichtig ist eigentlich nur das Feld QCID, um die Datensätze im nächsten
Schritt identifizieren und ausschließen zu können.)
Abfrage "12_QCKurseExport":
SELECT [1_QCKurseTbl].QCID,
[1_QCKurseTbl].hsec,
[1_QCKurseTbl].QCDatum,
[1_QCKurseTbl].QCWKN,
[1_QCKurseTbl].QCQuote,
[1_QCKurseTbl].QCCurrency
FROM CRNC
INNER JOIN ((1_QCKurseTbl
LEFT JOIN 11_QCKurseExist
ON [1_QCKurseTbl].QCID = [11_QCKurseExist].QCID)
INNER JOIN SEC
ON [1_QCKurseTbl].hsec = SEC.hsec)
ON CRNC.hcrnc = SEC.hcrnc
WHERE ((([1_QCKurseTbl].QCCurrency) =[CRNC.szIsoCode])
AND (([11_QCKurseExist].QCID) IS NULL));
Zwei weitere Sachen brauchen wir noch:
Eine Tabelle "2_QWBZeilen" mit den Feldern
* QCDatum Datum
* Zeile Text (255 Zeichen)
Eine Abfrage "13_QWBZeilen"
INSERT INTO 2_QWBZeilen
(
QCDatum,
Zeile )
SELECT [12_QCKurseExport].QCDatum,
[QCWKN] & "@" & REPLACE(Format([QCQuote],"General Number"),",",".")
& "@0@0@0@0@0@0@0@0@0@0@" & [QCCurrency] & "@" AS Zeile
FROM 12_QCKurseExport;
Diese Zwischenspeichertabelle ist notwendig, damit Access die Verbindung
zur MNY-Datei abbauen kann und trotzdem weiß, was zu tun ist. Wenn die
Verbindungen offen blieben, wäre die Kurstabelle SP für Money gesperrt
und es würde die QWB-Datei zwar einlesen, die Kurse aber nicht in der
Datenbank ablegen. Leider verhält sich Money so, ohne eine Nachricht an
den Benutzer zu geben...
Nun gilt es, aus den Datensätzen von "2_QWBZeilen" eine QWB-Datei pro
Tag zu erstellen und von Money einlesen zu lassen. Inklusive der
Vorarbeiten lasse ich das von VBA erledigen. Folgenden Code in ein neues
Modul hineinkopieren:
==== 8< ====== 8< =========
Option Compare Database
Option Explicit
'*
'* Definition der auf Modulebene gültigen Variablen *
'*
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ImportQCfromTxt()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sql As String ' SQL-String speichern
Set db = CurrentDb()
'* QC-Textdatei einlesen / Datensätze anfügen:
db.Execute ("10_QCKurseAppend")
'* QWB-Zeilen in Tabelle löschen und neu einfügen:
DoCmd.RunSQL ("Delete * from 2_QWBZeilen")
db.Execute ("13_QWBZeilen")
sql = "SELECT DISTINCT QCDatum FROM 2_QWBZeilen ORDER by QCDatum DESC;"
Debug.Print sql
Set rs = db.OpenRecordset(sql, dbOpenDynaset)
'* Über alle Zeilen: *
rs.MoveFirst
Do While (Not rs.EOF)
Debug.Print rs!QCDatum
Call QWB_erzeugen(rs!QCDatum)
Sleep (200)
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
Sub QWB_erzeugen(qwb_Datum As Date)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sql As String ' SQL-String speichern
Dim QWBFileName As String
QWBFileName = "P:\Money\QC\Kurse\QCdb.qwb"
'* QWB-Kopf schreiben (Datei neu erstellen / überschreiben):
Open QWBFileName For Output As #1
Print #1, "<FORMAT>QWB2.0"
Print #1, "<DATE>" & Format(CDate(qwb_Datum), "yyyymmdd") & "201000"
Close #1
Set db = CurrentDb()
sql = "Select [Zeile] from 2_QWBZeilen where ([QCDatum] = " &
CDateSQL(qwb_Datum) & ");"
Debug.Print sql
Set rs = db.OpenRecordset(sql, dbOpenDynaset)
Open QWBFileName For Append As #1
'* Über alle Zeilen: *
rs.MoveFirst
Do While (Not rs.EOF)
Debug.Print rs!Zeile
'* QWB-Zeile anhängen:
Print #1, rs!Zeile
rs.MoveNext
Loop
'* QWB-Datei schließen:
Close #1
rs.Close
Set rs = Nothing
Set db = Nothing
sql = RunFile(QWBFileName)
If sql > "" Then
Debug.Print sql
Stop
End If
End Sub
Public Function CDateSQL(vardatum As Variant) As String
'Quelle:
http://www.dbwiki.net/
If IsDate(vardatum) Then
CDateSQL = Format(CDate(vardatum), "\#mm\/dd\/yyyy\#")
Else
'entspricht 1.1.100
CDateSQL = -657434
End If
End Function
==== 8< ====== 8< =========
Routine "ImportQCfromTxt()" entweder von Hand oder über eine
Schaltfläche in einem Formular aufrufen.
Für "RunFile" braucht's noch diesen Code in einem weiteren Modul:
==== 8< ====== 8< =========
Option Compare Database
#If VBA7 Then '64 Bit-Versionen
Public Declare PtrSafe Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hWnd As LongPtr, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nshowcmd As Long) As Long
#Else '32 Bit-Versionen
Public Declare Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nshowcmd As Long) _
As Long
#End If
Public Enum eWinMode
SW_HIDE = 0
SW_NORMAL = 1
SW_MINIMIZE = 2
SW_MAXIMIZE = 3
SW_RESTORE = 9
End Enum
'Ziel nicht gefunden
Const SE_ERR_FNF = 2
'Pfad nicht gefunden
Const SE_ERR_PNF = 3
'Zugriff verweigert
Const SE_ERR_ACCESSDENIED = 5
'Nicht genügend Speicher
Const SE_ERR_OOM = 8
'Keine Win32/Win64 Anwendung
Const ERROR_BAD_FORMAT = 11
'Zugriffssverletzung
Const SE_ERR_SHARE = 26
'Unvollständige Erweiterung
Const SE_ERR_ASSOCINCOMPLETE = 27
'DDE-Fehler, TimeOut
Const SE_ERR_DDETIMEOUT = 28
'DDE-Fehler, Allgemein
Const SE_ERR_DDEFAIL = 29
'DDE-Fehler, Beschäftigt
Const SE_ERR_DDEBUSY = 30
'Erweiterung nicht mit Anwendung verknüpft
Const SE_ERR_NOASSOC = 31
'DLL nicht gefunden
Const SE_ERR_DLLNOTFOUND = 32
Function PrintFile( _
strFile As String, _
Optional strParas As String = "", _
Optional strDir As String = "", _
Optional WinMode As eWinMode = SW_NORMAL) As String
Dim R As Long, strErr As String
R = ShellExecute( _
Application.hWndAccessApp, _
"print", _
strFile, _
strParas, _
strDir, _
WinMode)
strErr = "" 'Default: Kein Fehler
If R < 33 Then 'Fehler
Select Case R
Case SE_ERR_FNF = 2
strErr = "Ziel nicht gefunden"
Case SE_ERR_PNF = 3
strErr = "Pfad nicht gefunden"
Case SE_ERR_ACCESSDENIED = 5
strErr = "Zugriff verweigert"
Case SE_ERR_OOM = 8
strErr = "Nicht genügend Speicher"
Case ERROR_BAD_FORMAT = 11
strErr = "Keine Win32/Win64 Anwendung"
Case SE_ERR_SHARE = 26
strErr = "Zugriffssverletzung"
Case SE_ERR_ASSOCINCOMPLETE = 27
strErr = "Unvollständige Erweiterung"
Case SE_ERR_DDETIMEOUT = 28
strErr = "DDE-Fehler, TimeOut"
Case SE_ERR_DDEFAIL = 29
strErr = "DDE-Fehler, Allgemein"
Case SE_ERR_DDEBUSY = 30
strErr = "DDE-Fehler, Beschäftigt"
Case SE_ERR_NOASSOC = 31
strErr = "Keine Anwendungsverknüpfung"
Case SE_ERR_DLLNOTFOUND = 32
strErr = "DLL nicht gefunden"
Case Else
strErr = "Fehler " & CStr(R) & " aufgetreten!"
End Select
End If 'Rückmeldung < 33?
PrintFile = strErr
End Function
Function RunFile( _
strFile As String, _
Optional strParas As String = "", _
Optional strDir As String = "", _
Optional WinMode As eWinMode = SW_NORMAL) As String
Dim R As Long, strErr As String
R = ShellExecute( _
Application.hWndAccessApp, _
"", _
strFile, _
strParas, _
strDir, _
WinMode)
strErr = "" 'Default: Kein Fehler
If R < 33 Then 'Fehler
Select Case R
Case SE_ERR_FNF = 2
strErr = "Ziel nicht gefunden"
Case SE_ERR_PNF = 3
strErr = "Pfad nicht gefunden"
Case SE_ERR_ACCESSDENIED = 5
strErr = "Zugriff verweigert"
Case SE_ERR_OOM = 8
strErr = "Nicht genügend Speicher"
Case ERROR_BAD_FORMAT = 11
strErr = "Keine Win32/Win64 Anwendung"
Case SE_ERR_SHARE = 26
strErr = "Zugriffssverletzung"
Case SE_ERR_ASSOCINCOMPLETE = 27
strErr = "Unvollständige Erweiterung"
Case SE_ERR_DDETIMEOUT = 28
strErr = "DDE-Fehler, TimeOut"
Case SE_ERR_DDEFAIL = 29
strErr = "DDE-Fehler, Allgemein"
Case SE_ERR_DDEBUSY = 30
strErr = "DDE-Fehler, Beschäftigt"
Case SE_ERR_NOASSOC = 31
strErr = "Keine Anwendungsverknüpfung"
Case SE_ERR_DLLNOTFOUND = 32
strErr = "DLL nicht gefunden"
Case Else
strErr = "Fehler " & CStr(R) & " aufgetreten!"
End Select
End If 'Rückmeldung < 33?
RunFile = strErr
End Function
==== 8< ====== 8< =========
--