VBSript-Tool für Übernahme Einzelbuchung als EB-Werte

[#1]

Hallo Leute,

da viele das Problem haben (werden), die EB-Wertübernahme für die Sachkonten-OP vorzutragen, habe ich einmal ein VBSript-Tool erstellt, welches mir ein OP-Kontoexport in Einzelbuchungssätzen exportiert.

Zur Vorgehensweise:

1. FiBu-Konto mit Sachkonto-OP (Option nur nicht ausgeblendete anzeigen)
   Das Konto muss als Jahreskonto eingestellt sein
2. FiBu-Konto nach Excel exportieren und geöffnet lassen. Die Feldreihenfolge ist völlig egal.
3. Mein VBSript-Tool starten
   Achtung: Die Pfade für die Exportdatei müssen an die persönlichen Verhältnisse angepasst werden. Einfach die VBS-Datei im Texteditor öffnen und bearbeiten.
4. Die Export-Datei (z. B. EB-Werte.csv) kann jetzt im neuen Jahr über den ASCII-Assistenten 'ASCII-Daten importieren' in die FiBu importiert werden.
   Einfach die Datei auswählen und
   => Bewegungsdaten -> Finanzbuchführung -> Buchungsstapel -> DATEV-Buchungsstapel auswählen

Das VBSript-Tool sollte leicht zugänglich gespeichert werden.

Und hier nun das Script:

Option Explicit

On Error Resume Next

Dim objExcel

Dim shtSource

Dim shtTarget

Dim objFSO

Set objExcel = GetObject(,"Excel.Application")

If err.number<>0  Then
Err.Clear
Set objExcel = CreateObject("Excel.Application")
End if

objExcel.Visible = True

Set objFSO = CreateObject("Scripting.FileSystemObject")


Dim iRow, q, iCol
Dim sValue(114)           'lt. Feldbeschreibung Buchungsstapel
Dim sTemp

Dim cDatum
Dim cBelegfeld1
Dim cBelegfeld2
Dim cBuchungstext
Dim cUmsatzSoll
Dim cUmsatzHaben
Dim cKOST1
Dim EB_Datum
Dim sTmp
Dim GGKto

'Pfade bitte anpassen
If objFSO.FileExists("\\server01\home\66\Documents\DATEV\DATEN\RWDAT\Export\EB_Werte.csv") then objfso.DeleteFile("\\server01\home\66\Documents\DATEV\DATEN\RWDAT\Export\EB_Werte.csv")

Set shtSource = objExcel.ActiveSheet
EB_Datum = InputBox( "Geben Sie bitte das EB-Datum in Form dd.mm.jjjj ein.","EB-Datum","01.01." & Year(Now()))
EB_Datum =FormatExt(Day(EB_Datum),1) & FormatExt(Month(EB_Datum),2)
sTmp = Split(shtSource.cells(1,1),"-")       'Auslesen des GGKto.

GGKto = Replace(Trim(sTmp(5))," ","")         'Replace, wg. Sachkontenlänge >4 (z. B. 3740 0)
Const xlCellTypeLastCell=11

'Auslesen der Feldreihenfolge
For iCol=1 To shtSource.usedrange.specialcells(xlCellTypeLastCell).Column
Select Case shtSource.cells(2,iCol).Text
Case "Datum":                       cDatum=iCol
Case "Belegfeld1":                   cBelegfeld1=iCol
Case "Belegfeld2":                   cBelegfeld2=iCol
Case "Buchungstext":               cBuchungstext=iCol
Case "Umsatz Soll":                   cUmsatzSoll=iCol
Case "Umsatz Haben":               cUmsatzHaben=iCol
Case "KOST1"                        cKOST1=iCol
End Select
Next


Dim MyFile
Set MyFile = objFSO.OpenTextFile("\\server01\home\66\Documents\DATEV\DATEN\RWDAT\Export\EB_Werte.csv", 2, True)   'Pfade bitte anpassen

'Spaltenüberschriften     neu
For iCol = 1 To 114
sTemp = sTemp & "Spalte " & iCol & ";"
Next

MyFile.Writeline sTemp



For iRow = 3 To shtSource.usedrange.specialcells(xlCellTypeLastCell).row

If shtSource.cells(iRow,cUmsatzSoll) <>"" Then
sValue(1) = shtSource.cells(iRow,cUmsatzSoll)
sValue(2)="S"
Else
sValue(1) = shtSource.cells(iRow,cUmsatzHaben)
sValue(2)="H"
End If        
sValue(7) = "9000"
sValue(8) = GGKto
sValue(10) = EB_Datum
sValue(11) = Trim(shtSource.cells(iRow,cBelegfeld1))
sValue(12) = Trim(shtSource.cells(iRow,cBelegfeld2))
sValue(14) = Trim(shtSource.cells(iRow,cBuchungstext))
sValue(37) = Trim(shtSource.cells(iRow,cKOST1))
sValue(114) = 0

sTemp=""

For q = 1 To 114
sTemp = sTemp & sValue(q) & ";"
Next

MyFile.Writeline sTemp

Next

MyFile.close
MsgBox "Fibu-Werte stehen zur Verfügung."          'neu

'Hilfsfunktion
Function FormatExt(Zahl,Anzahl)
      FormatExt= Right(String(Anzahl, "0") & zahl,Anzahl)
End Function

Den Code einfach kopieren und in eine Textdatei mit Extension (Endung) vbs speichern (z. B. FiBuKto2EB.vbs).

Das Tool kann natürlich an eigene Erfordernisse angepasst werden.

Ich habe das Tool getestet und es hat bei mir einwandfrei funktioniert. Ich übernehme aber keine Garantie für die Funktionsweise. Auch wird keine Haftung für Schäden übernommen. Wer das Tool verwendet, benutzt es auf eigene Verantwortung.

Gruß A. Martens

P.S. Wenn jemand Hilfe benötige, stehe ich gerne zur Verfügung. Ein Anspruch auf Support besteht aber nicht.

[#2]

Nachtrag:

Beim Import ist auf darauf zu achten, dass der Stapel keine Überschriften enthält. Also unbedingt abhaken (s. 2. Schritt).

Wem das zu lästig ist ergänzt einfach den Code wie folgt:

Nach folgender Zeile:

Dim MyFile

Set MyFile = objFSO.OpenTextFile("\\server01\home\66\Documents\DATEV\DATEN\RWDAT\Export\EB_Werte.csv", 2, True)   'Pfade bitte anpassen

'Spaltenüberschriften
For iCol = 1 To 114
    sTemp = sTemp & "Spalte " & iCol & ";"
Next

    MyFile.Writeline sTemp

    

Damit wird in der ersten Zeile eine Spaltenüberschrift 'Spalte 1' ... eingefügt.

So braucht man den Haken nicht immer abwählen.

Zum Schluss würde ich noch eine Msgbox ausgeben, damit der Anwender eine kleine Info bekommt.

Einfach nach folgender Zeile:

MyFile.close

MsgBox "Fibu-Werte stehen zur Verfügung."

einfügen.

Gruß A. Martens

P.S. Den Code vom vorherigen Threat habe ich angepasst.

[#3]

Hallo,

gerade getestet - funktioniert problemlos, Danke.

[#4]

Danke für die Rückmeldung.

Für diejenigen, die mit längeren Kontonummer (>4 Stellen, z. B. 3740 0) arbeiten, benötigen noch eine kleine Modifikation, die ich schon eingebaut habe.

GGKto = Replace(Trim(sTmp(5))," ","")

Da die Textformatierung in der ersten Zeile Leerzeichen enthält, müssen diese noch gelöscht werden. Bitte dann auch darauf achten, dass das EB-Konto angepasst wird.

Das könnte man auch ganz bequem über eine Inputbox lösen:

Beispiel:

Dim EB_Konto

EB_Konto = InputBox("Geben Sie bitte das EB-Konto ein (o. Leerzeichen).","EB-Konto","9000")

[...]

sValue(7) = EB_Konto

[...]

[#5]

Hallo Archilleus,

haben Sie vielen, vielen Dank! Das funktioniert hervorragend. Eine massive Arbeitserleichterung!

Noch zwei kleine Tipps in die Runde:

1. Wenn der Name Ihres Mandanten ein "-" enthält, müssen Sie das "-" in dem in Excel geöffneten Kontoblatt aus dem Namen herauslöschen. Sonst kann das Gegenkonto nicht ermittelt werden, siehe Skript-Zeile (glaube ich zumindest):

sTmp = Split(shtSource.cells(1,1),"-")       'Auslesen des GGKto.

(Rein zufällig hatte gerade der erste Mandant, wo ich es einmal testen wollte, einen Namen mit Bindestrich.)

2. Eventuell muss S/H vertauscht werden:

Statt

If shtSource.cells(iRow,cUmsatzSoll) <>"" Then

sValue(1) = shtSource.cells(iRow,cUmsatzSoll)

sValue(2)="S"

Else

sValue(1) = shtSource.cells(iRow,cUmsatzHaben)

sValue(2)="H"

End If        

sValue(7) = "9000"

sValue(8) = GGKto

sValue(10) = EB_Datum

sValue(11) = Trim(shtSource.cells(iRow,cBelegfeld1))

sValue(12) = Trim(shtSource.cells(iRow,cBelegfeld2))

sValue(14) = Trim(shtSource.cells(iRow,cBuchungstext))

sValue(37) = Trim(shtSource.cells(iRow,cKOST1))

sValue(114) = 0

dann

If shtSource.cells(iRow,cUmsatzSoll) <>"" Then

sValue(1) = shtSource.cells(iRow,cUmsatzSoll)

sValue(2)="H"

Else

sValue(1) = shtSource.cells(iRow,cUmsatzHaben)

sValue(2)="S"

End If       

sValue(7) = "9000"

sValue(8) = GGKto

sValue(10) = EB_Datum

sValue(11) = Trim(shtSource.cells(iRow,cBelegfeld1))

sValue(12) = Trim(shtSource.cells(iRow,cBelegfeld2))

sValue(14) = Trim(shtSource.cells(iRow,cBuchungstext))

sValue(37) = Trim(shtSource.cells(iRow,cKOST1))

sValue(114) = 0

Zumindest war es bei mir so. Kontoblatt war in der Jahresansicht mit auf Standard zurückgesetzter Liste geöffnet. (Hatte es für zwei Konten getestet. Vorhin nur auf den Wert geschaut, nicht auf Soll und Haben; und habe mir nun gerade bei der Abstimmung Konten 9000 - 9009 einen Wolf gesucht )

Das soll jetzt aber kein Klugscheißen sein! Ich hätte nie so ein tolles Skript hinbekommen.

VG

[#6]

Danke für den Hinweis mit dem S/H-Kennzeichen. Ich werde das morgen noch einmal testen und auch gleich das Problem mit dem '-' im Namen prüfen.

Gruß A. Martens

[#7]

Hallo Leute,

ich habe jetzt die gesamte Programmroutine für den Vortrag der EB-Werte überarbeitet.

Folgende Features sind eingearbeitet und von mir getestet:

1. Ermittlung der EB-Werte aus allen Kontenbereichen
   - Normales Konto
   - Arbeitskonto
   - Jahresabschlusskonto
2. Sachkontolänge wird automatisch ermittelt
   Für das EB-Konto wird jetzt die richtige Sachkontenlänge ermittelt und entsprechend automatisch berücksichtigt. Getestet mit 4 Stellen (Standardlänge), 5 u. 7 Stellen.
   
   
3. mehrmaliger Export in eine Datei
   Da beim Import in DATEV bestimmt werden kann, dass die Exportdatei nach erfolgten Import gelöscht werden soll, braucht die Löschung nicht mehr im VBScript erfolgen. Dadurch ist man jetzt in der Lage mehrere EB-Konten auf einmal zu exportieren. Das spart Zeit. Die Spaltenbeschriftungen sind standardmäßig aktiviert und werden daher auch mit ausgegeben (kein Umschalten mehr).
4. Das EB-Datum kann von Hand über eine Inputbox variabel verwendet werden (Rumpfwirtschaftsjahr).
5. Als Exportmittler wird Excel benötigt.
6. In der Excel-Datei dürfen keine Zeilen gelöscht oder hinzugefügt werden, ohne das gespeichert wird. Da bis zu letzten Zelle (usedrange) gelesen wird, würde ein manuelles ändern nicht berücksichtigt werden. Aus diesem Grunde sind die Abstimmungsarbeiten in DATEV vorzunehmen. Es wird immer von einem abgestimmten Konto ausgegangen.
7. Import erfolgt über DATEV -> ASCII-Daten -> Buchungsliste.
8. Exportpfade sind manuell anzupassen.
9. Nicht getestet wurden Kontokorrentkonten. Aber dafür gibt es auch die OP-Funktion.

Und hier nun das getestete Script:
Bitte den Text kopieren und in einer Textdatei mit Extension *.vbs speichern (z. B. DATEV_EBWerte.vbs). Alle Codezeilen sind einzeilig (bitte ggf. anpassen).

Option Explicit

Dim objExcel
Dim shtSource
Dim shtTarget
Dim iRow, q, iCol
Dim sValue(114)           'lt. Feldbeschreibung Buchungsstapel
Dim sTemp

On Error Resume Next

Set objExcel = GetObject(,"Excel.Application")

If err.number<>0  Then
    Err.Clear
    Set objExcel = CreateObject("Excel.Application")
End if

objExcel.Visible = True

On Error Goto 0

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")


Dim cDatum
Dim cBelegfeld1
Dim cBelegfeld2
Dim cBuchungstext
Dim cUmsatzSoll
Dim cUmsatzHaben
Dim cKOST1
Dim EB_Datum
Dim sTmp
Dim GGKto, iLenKonto
Dim sKtoSplitter

'Pfade bitte anpassen
'muss nicht gelöscht werden, da beim Import in DATEV diese Datei gelöscht werden kann.
'Damit ist es jetzt möglich, mehrere Konten mit EB-Wert vorzutragen (s. ForAppending)
'If objFSO.FileExists("\\server01\home\66\Documents\DATEV\DATEN\RWDAT\Export\EB_Werte.csv") then objfso.DeleteFile("\\server01\home\66\Documents\DATEV\DATEN\RWDAT\Export\EB_Werte.csv")

Set shtSource = objExcel.ActiveSheet
EB_Datum = InputBox( "Geben Sie bitte das EB-Datum in Form dd.mm.jjjj ein.","EB-Datum","01.01." & Year(Now()))
EB_Datum =FormatExt(Day(EB_Datum),1) & FormatExt(Month(EB_Datum),2)

If InStr(1,shtSource.cells(1,1),"Abschlusskonto",1)<>0 Then    'Export aus Abschluss
    sKtoSplitter="Abschlusskonto"
ElseIf InStr(1,shtSource.cells(1,1),"Kontoblatt",1)<>0 Then    'Export aus Kontoblatt
    sKtoSplitter="Kontoblatt"
ElseIf InStr(1,shtSource.cells(1,1),"Arbeitskonto",1)<>0 Then    'Export aus Arbeitskonto
    sKtoSplitter="Arbeitskonto"
Else
    MsgBox "Der Kontoexport konnte nicht erkannt werden. Es werden nur Arbeitskonto, normales Konto u. Abschlusskonto unterstützt.",vbCritical, "Exportfehler"
    WScript.Quit
End If
'sTmp=Split(shtSource.cells(1,1),"Arbeitskonto",0,1)

sTmp = Split(shtSource.cells(1,1),sKtoSplitter,2,1)       'Auslesen des GGKto.
GGKto =GetEBKonto(sTmp(1))                                      'letzte Trennung falls mehrere '-' vorhanden
iLenKonto = LenKonto(GGKto)
Const xlCellTypeLastCell=11

'Auslesen der Feldreihenfolge
For iCol=1 To shtSource.usedrange.specialcells(xlCellTypeLastCell).Column
    Select Case shtSource.cells(2,iCol).Text
        Case "Datum":                       cDatum=iCol
        Case "Belegfeld1":                   cBelegfeld1=iCol
        Case "Belegfeld2":                   cBelegfeld2=iCol
        Case "Buchungstext":               cBuchungstext=iCol
        Case "Umsatz Soll":                   cUmsatzSoll=iCol
        Case "Umsatz Haben":               cUmsatzHaben=iCol
        Case "KOST1":                       cKOST1=iCol
    End Select
Next


Dim MyFile
Const ForReading = 1, ForWriting = 2, ForAppending = 8


If objFSO.FileExists("\\server01\home\66\Documents\DATEV\DATEN\RWDAT\Export\EB_Werte.csv") = False then
    'Spaltenüberschriften
    For iCol = 1 To 114
        sTemp = sTemp & "Spalte " & iCol & ";"
    Next
End If

Set MyFile = objFSO.OpenTextFile("\\server01\home\66\Documents\DATEV\DATEN\RWDAT\Export\EB_Werte.csv", ForAppending, True)   'Pfade bitte anpassen

If Len(sTemp)>0 Then    MyFile.Writeline sTemp


For iRow = 3 To shtSource.usedrange.specialcells(xlCellTypeLastCell).row

    If shtSource.cells(iRow,cUmsatzSoll) <>"" Then
        sValue(1) = shtSource.cells(iRow,cUmsatzSoll)
        sValue(2)="H"
    Else
        sValue(1) = shtSource.cells(iRow,cUmsatzHaben)
        sValue(2)="S"
    End If        
    
    sValue(7) = "9" & String(iLenKonto-1, "0")
    sValue(8) = Replace(GGKto," ","")
    sValue(10) = EB_Datum
    If Not IsEmpty(cBelegfeld1) Then sValue(11) = Trim(shtSource.cells(iRow,cBelegfeld1))
    If Not IsEmpty(cBelegfeld2) Then sValue(12) = Trim(shtSource.cells(iRow,cBelegfeld2))
    If Not IsEmpty(cBuchungstext) Then sValue(14) = Trim(shtSource.cells(iRow,cBuchungstext))
    If Not IsEmpty(cKOST1) Then sValue(37) = Trim(shtSource.cells(iRow,cKOST1))
    sValue(114) = 0
    
    sTemp=""
    
    For q = 1 To 114
        sTemp = sTemp & sValue(q) & ";"
    Next
    
    MyFile.Writeline sTemp
    
Next

MyFile.close

MsgBox "Fibu-Werte stehen zur Verfügung."

'Hilfsfunktion
Function FormatExt(Zahl,Anzahl)
    FormatExt= Right(String(Anzahl, "0") & zahl,Anzahl)
End Function


Function GetEBKonto(EBValue)
     GetEBKonto = Trim(Mid(EBValue, 3, InStr(3, EBValue, " - ", vbTextCompare) - 3))
End Function

Function LenKonto(Konto)
    If Len(konto) > 4 Then
        LenKonto = 4 + Len(Right(Konto, Len(Konto) - InStr(1, Konto, " ", vbTextCompare)))
    Else
        LenKonto = 4
    End If        
End Function

Sollten dennoch noch Fehler auftauchen, dann bitte hier melden.

Wie immer gilt:
Ich übernehme keine Verantwortung für irgendwelche Schäden. Das Tool ist von mir getestet und es traten bei mir keine Probleme auf. Anspruch auf Support besteht nicht. Bin aber gerne bereit zu helfen.

Viel Spaß.

Gruß A. Martens

[#8]

Hallo,

fehlt in dieser Zeile

Case "KOST1"                        cKOST1=iCol

nicht noch ein Doppelpunkt nach "KOST1"?

Unabhängig davon erhalten ich eine Fehlermeldung

Zeile:101

Zeichen 5

Unbekannter Laufzeitfehler

Code: 800A03EC

[#9]

Hallo,

fehlt in dieser Zeile

Case "KOST1"                        cKOST1=iCol

nicht noch ein Doppelpunkt nach "KOST1"?

Stimmt, war mir gar nicht aufgefallen. Habe ich im Script nachtgetragen.

Zu dem Fehler:

Ich kann den Fehler nicht reproduzieren. Bei mir läuft das Tool durch.

Können Sie ein Screenshot hier hochladen?

[#10]

Hallo,

ich habe noch ein wenig rumgetestet und im Code die Zeile

sValue(12) = Trim(shtSource.cells(iRow,cBelegfeld2))

und

sValue(37) = Trim(shtSource.cells(iRow,cKOST1))

auskommentiert da diese Spalten im Kontoblatt nicht angezeigt werden.

Danach ist der Code durchgelaufen.

[#11]

So, jetzt noch einmal mit Prüfung, ob auch die Spalten vorhanden sind (IsEmpty). Damit sollte jetzt auch wirklich jede Möglichkeit geprüft werden.

Danke für das Testen.

Das letzte Script ist zu verwenden. Änderungen/Ergänzungen sind hinzugefügt.

Gruß A. Martens

[#12]

Hallo,

sorry wenn ich mich schon wieder melde, aber fehlt hier nicht auch etwas?

End Function

   Nz(oldValue, NewValue)

    If oldValue ="" Then oldValue=NewValue

End Function

[#13]

Die Nz-Funktion sollte nicht mit kopiert werden. Ist eine nichtbenötigte Hilfsfunktion gewesen. Da ist mir beim Editieren ein Fehler unterlaufen.

Danke für den Hinweis.

[#14]

Hallo,

vielen Dank für Ihre Optimierungen! Habe es jetzt beim gleichen Mandanten wie neulich getestet: "-" im Mandantennamen stört jetzt nicht mehr, und auch Soll/Haben laufen jetzt richtig herum.

Richtig super ist auch die neue Funktion, mehrere Konten gleichzeitig verarbeiten zu können!

[#15]

Hallo 0815,

kopiere die bitte noch einmal das letzte Script aus dem Posting vom 22.02.17.

Dieser Fehler mir nämlich auch noch aufgefallen und ich sollte das mit der folgenden Code-Anweisung berichtigt haben.

If objFSO.FileExists("\\server01\home\66\Documents\DATEV\DATEN\RWDAT\Export\EB_Werte.csv") = False then

    'Spaltenüberschriften

    For iCol = 1 To 114

        sTemp = sTemp & "Spalte " & iCol & ";"

    Next

End If

Vielen Dank für die Rückäußerung.

Sollten doch noch Probleme auftauchen, dann bitte einfach melden.

Gruß A. Martens

[#16]

Ha! Daran lag's nicht, hatte schon den aktuellen Code kopiert. Aber, faul wie ich bin, habe ich nur [Strg]+[F] "pfad". Und so habe ich an dieser Stelle verpasst, den Pfad anzupassen ... Asche auf mein Haupt

Lief jetzt einwandfrei durch. Danke für den schnellen Support! Habe meinen vorherigen Post entsprechend angepasst, damit gar nicht erst jemand durcheinander kommt.

[#17]

Hallo Herr Martens,

vielen Dank für die viele Mühe und auch an die anderen Optimierer. Da ich keine Ahnung vom Scripten habe, würde ich das gern an meine interne Hackergruppe weitergeben

Nur noch eine Frage dazu, verarbeiten Sie damit auch unterschiedliche Währungen? Das ist ja das Hauptproblem von E-Zahlungsverkehr, das scheinbar jemand programmiert hat, der noch nicht bemerkt hat, dass es außer dem Euro noch andere Währungen gibt, in der die Kunden des für uns alle neuen Internets nun bezahlen ...

Viele Grüße aus der Lausitz

F. Schwella

[#18]

Hallo Hr. Schwella,

mit Währungen habe ich mich bisher, mangels Notwendigkeit, nicht beschäftigt. Alle meine Scripte basieren auf EURO.

Gruß A. Martens

[#19]

Okay danke für die rasche Antwort.

Gruß

fs

[#20]

Hallo Herr Martens,

es ist wieder Jahreswechsel - und gestern hat mir Ihr Werkzeug zum ersten Mal dieses Jahr wieder gute Dienste geleistet

Wenn Sie mal Zeit & Lust haben: Können Sie mir u.U. sagen, welche Stelle man anpassen kann, damit Semikolons im Buchungstext ignoriert werden oder dergleichen? Wenn man ";" im Buchungstext hat, führt das dazu, dass der Buchungstext vor dem ";" abgeschnitten wird, und der Teil nach dem ";" in die nächste Spalte - Spalte Postensperre - rutscht.

Vielleicht kann man das ja umgehen. Mir ist natürlich bewusst, dass es schlicht unklug ist, Semikolons im Buchungstext zu haben, da diese ja nun mal Trennzeichen sind. Wenn es nicht geht (was ich ein wenig befürchte), ersetze ich die Semikolons einfach weiter im in Excel geöffneten Kontoblatt via Suchen und Ersetzen, das geht ja auch fix.

Viele Grüße.

[#21]

Hallo 0815,

ich werde das mal bei Gelegenheit prüfen, da ich sowieso an das Tool noch einmal ran muss, da bei einem anderen Fall die Banken.csv nicht richtig erstellt wird. Hier hatte ja jemand schon einmal das Problem. Soweit ich mich erinnere, lag das an der Art und Weise wie die Rohdaten von PayPal heruntergeladen wurden. Ich will da jetzt aber endlich einmal eine generelle Lösung haben. In dem Zusammenhang werde ich mir das einmal mit dem Semikolon anschauen. Das dauert aber etwas.

Gruß A. Martens

[#22]

Hallo Herr Martens,

ja natürlich, kein Stress

Viele Grüße.

[#23]

Vielen Dank für das Tool. Ich habe es gerade genutzt.

Die Spalte Konto hatte die Nummer "9000000"

Nach dem Import habe ich die leeren Konto-Felder mit der Hand ergänzt.

Wunderbares Tool. VIELEN DANK!

[#24]

Hallo Herr Martens,

es ist wieder Jahreswechsel - und gestern hat mir Ihr Werkzeug zum ersten Mal dieses Jahr wieder gute Dienste geleistet

Wenn Sie mal Zeit & Lust haben: Können Sie mir u.U. sagen, welche Stelle man anpassen kann, damit Semikolons im Buchungstext ignoriert werden oder dergleichen? Wenn man ";" im Buchungstext hat, führt das dazu, dass der Buchungstext vor dem ";" abgeschnitten wird, und der Teil nach dem ";" in die nächste Spalte - Spalte Postensperre - rutscht.

Vielleicht kann man das ja umgehen. Mir ist natürlich bewusst, dass es schlicht unklug ist, Semikolons im Buchungstext zu haben, da diese ja nun mal Trennzeichen sind. Wenn es nicht geht (was ich ein wenig befürchte), ersetze ich die Semikolons einfach weiter im in Excel geöffneten Kontoblatt via Suchen und Ersetzen, das geht ja auch fix.

Viele Grüße.

Hallo 0815,

ich habe mir das Script noch einmal genau angeschaut und habe folgenden Lösungsvorschlag für Sie:

Da Ihr Problem ja eindeutig im Buchungstext liegt, würde IMO folgende Codeergänzung völlig ausreichen:

If Not IsEmpty(cBuchungstext) Then sValue(14) = Replace(Trim(shtSource.cells(iRow,cBuchungstext)),";",",")

Damit sollten jetzt alle Semikolons durch Kommata ersetzt werden.

Vielleicht sollte man das sogar als Standard im Script aufnehmen?

Probieren Sie es einfach einmal aus.

Gruß A. Martens

Änderung:

Präzisierung der Problemlösung.

[#25]

Hallo Herr Martens,

genial, funktioniert einwandfrei:

-->

"Vielleicht sollte man das sogar als Standard im Script aufnehmen?" Warum nicht? So sieht das aktuelle Skript momantan bei mir aus (keine eigenen Änderungen, nur mit Pfad S:\):

Option Explicit

Dim objExcel

Dim shtSource

Dim shtTarget

Dim iRow, q, iCol

Dim sValue(114)           'lt. Feldbeschreibung Buchungsstapel

Dim sTemp

On Error Resume Next

Set objExcel = GetObject(,"Excel.Application")

If err.number<>0  Then

    Err.Clear

    Set objExcel = CreateObject("Excel.Application")

End if

objExcel.Visible = True

On Error Goto 0

Dim objFSO

Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim cDatum

Dim cBelegfeld1

Dim cBelegfeld2

Dim cBuchungstext

Dim cUmsatzSoll

Dim cUmsatzHaben

Dim cKOST1

Dim EB_Datum

Dim sTmp

Dim GGKto, iLenKonto

Dim sKtoSplitter

'Pfade bitte anpassen

'muss nicht gelöscht werden, da beim Import in DATEV diese Datei gelöscht werden kann.

'Damit ist es jetzt möglich, mehrere Konten mit EB-Wert vorzutragen (s. ForAppending)

'If objFSO.FileExists("S:\EB_Werte.csv") then objfso.DeleteFile("S:\EB_Werte.csv")

Set shtSource = objExcel.ActiveSheet

EB_Datum = InputBox( "Geben Sie bitte das EB-Datum in Form dd.mm.jjjj ein.","EB-Datum","01.01." & Year(Now()))

EB_Datum =FormatExt(Day(EB_Datum),1) & FormatExt(Month(EB_Datum),2)

If InStr(1,shtSource.cells(1,1),"Abschlusskonto",1)<>0 Then    'Export aus Abschluss

    sKtoSplitter="Abschlusskonto"

ElseIf InStr(1,shtSource.cells(1,1),"Kontoblatt",1)<>0 Then    'Export aus Kontoblatt

    sKtoSplitter="Kontoblatt"

ElseIf InStr(1,shtSource.cells(1,1),"Arbeitskonto",1)<>0 Then    'Export aus Arbeitskonto

    sKtoSplitter="Arbeitskonto"

Else

    MsgBox "Der Kontoexport konnte nicht erkannt werden. Es werden nur Arbeitskonto, normales Konto u. Abschlusskonto unterstützt.",vbCritical, "Exportfehler"

    WScript.Quit

End If

'sTmp=Split(shtSource.cells(1,1),"Arbeitskonto",0,1)

sTmp = Split(shtSource.cells(1,1),sKtoSplitter,2,1)       'Auslesen des GGKto.

GGKto =GetEBKonto(sTmp(1))                                      'letzte Trennung falls mehrere '-' vorhanden

iLenKonto = LenKonto(GGKto)

Const xlCellTypeLastCell=11

'Auslesen der Feldreihenfolge

For iCol=1 To shtSource.usedrange.specialcells(xlCellTypeLastCell).Column

    Select Case shtSource.cells(2,iCol).Text

        Case "Datum":                       cDatum=iCol

        Case "Belegfeld1":                   cBelegfeld1=iCol

        Case "Belegfeld2":                   cBelegfeld2=iCol

        Case "Buchungstext":               cBuchungstext=iCol

        Case "Umsatz Soll":                   cUmsatzSoll=iCol

        Case "Umsatz Haben":               cUmsatzHaben=iCol

        Case "KOST1":                       cKOST1=iCol

    End Select

Next

Dim MyFile

Const ForReading = 1, ForWriting = 2, ForAppending = 8

If objFSO.FileExists("S:\EB_Werte.csv") = False then

    'Spaltenüberschriften

    For iCol = 1 To 114

        sTemp = sTemp & "Spalte " & iCol & ";"

    Next

End If

Set MyFile = objFSO.OpenTextFile("S:\EB_Werte.csv", ForAppending, True)   'Pfade bitte anpassen

If Len(sTemp)>0 Then    MyFile.Writeline sTemp

For iRow = 3 To shtSource.usedrange.specialcells(xlCellTypeLastCell).row

    If shtSource.cells(iRow,cUmsatzSoll) <>"" Then

        sValue(1) = shtSource.cells(iRow,cUmsatzSoll)

        sValue(2)="H"

    Else

        sValue(1) = shtSource.cells(iRow,cUmsatzHaben)

        sValue(2)="S"

    End If       

    sValue(7) = "9" & String(iLenKonto-1, "0")

    sValue(8) = Replace(GGKto," ","")

    sValue(10) = EB_Datum

    If Not IsEmpty(cBelegfeld1) Then sValue(11) = Trim(shtSource.cells(iRow,cBelegfeld1))

    If Not IsEmpty(cBelegfeld2) Then sValue(12) = Trim(shtSource.cells(iRow,cBelegfeld2))

    If Not IsEmpty(cBuchungstext) Then sValue(14) = Replace(Trim(shtSource.cells(iRow,cBuchungstext)),";",",")

    If Not IsEmpty(cKOST1) Then sValue(37) = Trim(shtSource.cells(iRow,cKOST1))

    sValue(114) = 0

    sTemp=""

    For q = 1 To 114

        sTemp = sTemp & sValue(q) & ";"

    Next

    MyFile.Writeline sTemp

Next

MyFile.close

MsgBox "Fibu-Werte stehen zur Verfügung."

'Hilfsfunktion

Function FormatExt(Zahl,Anzahl)

    FormatExt= Right(String(Anzahl, "0") & zahl,Anzahl)

End Function

Function GetEBKonto(EBValue)

     GetEBKonto = Trim(Mid(EBValue, 3, InStr(3, EBValue, " - ", vbTextCompare) - 3))

End Function

Function LenKonto(Konto)

    If Len(konto) > 4 Then

        LenKonto = 4 + Len(Right(Konto, Len(Konto) - InStr(1, Konto, " ", vbTextCompare)))

    Else

        LenKonto = 4

    End If       

End Function

Viele Grüße.

​Bearbeitet 16.02.2018 um 13:08 Uhr: Code gestrichen, nicht mehr aktuell.

[#26]

Das Leben kann doch so schön sein.

Danke für die Rückmeldung. Es kann ja jeder jetzt selbst anpassen, wie er es möchte.

Gruß A. Martens

[#27]

Guten Tag Herr Martens,

ich finde Ihre Lösung sehr interessant und freue mich auf alles, was das Leben leichter macht.

Würden Sie mir helfen, diese bei mir umzusetzen?

Viele Grüße aus Mittelhessen

Tel. 06422/928212

Michael Zoll

[#28]

Hallo Hr. Zoll,

die Vorgehensweise ist wirklich sehr simpel.

1. Kopieren Sie sich den Programmcode von 0815 (s. Beitrag 05.02.18).

(=> nur den grau hinterlegten Text. )

2. Erstellen Sie z. B. auf dem Desktop eine Textdatei und kopieren Sie den kopierten Text in diese Datei und speichern die Datei z. B. unter den Namen "EB-Werte.txt".

Passen Sie bitte die Pfade an:

If objFSO.FileExists("S:\EB_Werte.csv") = False then

[...]

Set MyFile = objFSO.OpenTextFile("S:\EB_Werte.csv", ForAppending, True)   'Pfade bitte anpassen

Ich würde immer den DATEV-Exportpfad empfehlen:

"C:\Users\ama\Documents\DATEV\DATEN\RWDAT\Export\EB_Werte.csv"

Schließen Sie diese Datei und benennen Sie die um in "EB-Werte.vbs".

Damit wären die Vorarbeiten abgeschlossen.

Öffnen Sie in DATEV jetzt das Konto, von dem Sie die einzelne Werte als EB-Vortrag haben möchten und wählen Sie das Kontextmenü "Liste öffnen mit Excel". Das Konto sollte natürlich schon ausgeziffert, also abgestimmt sein.

Lassen Sie Excel offen und starten Sie das VBSript mit einem Doppelklick auf Ihrem Desktop. Sie erhalten eine Inputbox mit der Datumsvorgabe, ggf. überschreiben.

Anschließend wird jetzt eine CSV-Buchungsdatei im Exportpfad erstellt.

Wechseln Sie wieder zu DATEV und wählen Sie "ASCII-Daten importieren" und wählen das Format "Buchungstapel" aus und öffnen die Exportdatei über die Auswahl Importquelle (Pfaddialog).

Es wird die CSV-Datei eingelesen und anschließend mit dem Befehl "Verarbeiten" in einem Vorlauf importiert.

Das war's.

Sie können übrigens div. Konten auf diese Weise gleichzeitig aufbereiten und ganz zum Schluß importieren.

Gruß A. Martens

[#29]

Hallo Herr Martens,

Vielen Dank für Ihre Bemühungen !

Ich werde es ausprobieren.

Finde es super , dass Sie sich so für die Gemeinschaft einbringen.

Gruß

Michael Zoll

[#30]

Vielen Dank.

Wir müssen schließlich irgendwie gemeinsam mit den Unzulänglichkeiten, und die sind nicht zu knapp, von DATEV zurechtkommen.

Ich wünsche noch ein schönes Wochenende.

Gruß A. Martens