Hallo Herr Mertens,
wenn das Thema gerade wieder aktuell ist. Habe das Tool mal auch auf die Lieblingskollegin losgelassen. Danach hat sie das Datev-EB-Werte-Ausziffern mit Einzelbuchungen sofort wieder verworfen 
Allerdings: Auch wenn ich hier:
Abbrechen klicke, werden die EB-Werte erzeugt, im Zweifel also auch doppelt in die "EB_Werte.csv" hineingeschrieben. Kann man das abändern? Tut mir leid, dass ich immer blöd fragen muss - ich habe leider von VBScript keinen blassen Dunst ...
Und falls nicht, dann dies zumindest als Hinweis an alle, die das geniale Tool auch nutzen.
Schönes Wochenende & viele Grüße.
Genial. Heute mal eine längere Mittagspause gemacht - und schon ist die Lösung da.
Finde es super , dass Sie sich so für die Gemeinschaft einbringen.
Dem ist nichts hinzuzufügen!
Hier noch mal der komplette Code (mit Pfad "S:\" und Ersetzung von ";" durch ","):
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()))
If EB_Datum="" then
'[´....] Tu was wenn leer
Else
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 'Pfade bitte anpassen
'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."
End if
'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
Eine Kleinigkeit habe ich noch ergänzt:
If objFSO.FileExists("S:\EB_Werte.csv") = False then 'Pfade bitte anpassen
(Zumindest das habe ich hinbekommen )
Viele Grüße & ein schönes Wochenende.
Hallo Frau Detlefs,
der hier: https://www.datev-community.de/message/48650#48650 ist der aktuelle 
Viele Grüße.
Sehr nettes kleines Tool!
Hoffentlich wird es dann bald mal auch von Datev richtig umgesetzt!
Hab Ihr auch schonmal das Programm Bestandsaufbau benutzt ?
Als Admin unter C:\DATEV\PROGRAMM\RWAPPLIC zu finden 
könnte dem einen oder anderen auch helfen. Vielleicht für welche die sich nicht ganz so gut mit VB auskennen.
Hat zwar nicht ganz den selben Zweck, aber kann man für den einen oder anderen Sachverhalt auch gut gebrauchen! (bei uns z.B. Nummernlogik der Opos-Konten zum Jahreswechsel ändern).
Tolles Tool Danke!
Also ich nutze das Tool jetzt schon das zweite Jahr und kann nur sagen:
DANKE DANKE DANKE !!! 
Super, dass wir so engagierte Kollegen haben, die ihr Wissen mit uns teilen.
Gruß
Yvonne Schaupp-Klein
Hallo Hr. Schneider,
vielen Dank für Blumen. 
Zu Ihrer Frage einfach das Script wie folgt ergänzen:
Die komplette Schnittstelle ist in Dokument 1036228 beschrieben.
[...]
Dim cKOST1
Dim cKOST2
[...]
'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
case "KOST2": cKOST2=iCol
End Select
[...]
If Not IsEmpty(cKOST1) Then sValue(37) = Trim(shtSource.cells(iRow,cKOST1))
If Not IsEmpty(cKOST2) Then sValue(38) = Trim(shtSource.cells(iRow,cKOST2))
sValue(114) = 0
Das sollte im Grunde alles sein.
Natürlich muss beim Export die KOST2 auch im Kontoblatt angezeigt werden. Aber das setze ich einmal voraus.
Gruß A. Martens
Hallo Herr Martens,
vielen Dank für das sonnige Wochenende. Es ist angekommen! 
Ich habe den Fehler gefunden.
Ich hatte in den Kontoeigenschaften | OPOS-Funktion den Haken bei "Ausziffern EB-Wert mit Einzelbuchungen" sitzen. Den habe ich nun rausgenommen. In der Folge wurden die bisherigen Zuordnungen verworfen. Ordnet man dann neu zu, ist alles wie es sein soll.
Viele Grüße,
Olaf Bietz
Hallo Herr Martens,
bei mir kommt nun die folgende Fehlermeldung:
Die (glaube ich) entscheide Stelle im Skript lautet:
Hat sich hier irgendwas geändert?
Vielen Dank
J. Schneider