Ein VBSript ist im Grunde eine reine Textdatei die beim Aufrufen von Windows in Programmcode kompiliert und verarbeitet wird.
Daher erstellen Sie eine neue Text-Datei im Explorer:
-> Kontextmenü -> Neu -> Textdatei
Fügen Sie folgenden Inhalt in die geöffnete Textdatei ein:
'###################################
'# #
'# PayPal2DATEV #
'# (V. 2.0) #
'###################################
Option Explicit
Dim objFSO
Dim sPathExport
sPathExport="C:\Users\ama\Documents\Tools"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(sPathExport & "\Banken.csv") Then
objFSO.DeleteFile(sPathExport & "\Banken.csv")
End If
On Error Resume Next
'############### Step 1 -> CSV in ANSI konvertieren
Private Const adReadAll = -1
Private Const adSaveCreateOverWrite = 2
Private Const adTypeBinary = 1
Private Const adTypeText = 2
Private Const adWriteChar = 0
UTF8toANSI WScript.Arguments(0), WScript.Arguments(0)
'############### Step 2 -> Über Excel in Spalten konvertieren
Dim objExcel
Dim objWkb
Dim objWks
Set objExcel = GetObject(,"Excel.Application")
If err.number<>0 Then
Err.Clear
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add
End if
Set objWks = objExcel.Workbooks(1).Sheets(1)
objExcel.Visible = True
Dim objReadFile
Set objReadFile =objFSO.OpenTextFile(WScript.Arguments(0), 1)
Dim colBank(34) 'Spaltendefinition siehe DATEV-Schnittstelle (Feld 1 - 34)
Dim curGeb
Dim sTemp
Dim MyResult
Dim i, lCol, lRow
Do Until objReadFile.AtEndOfStream
sTemp=objReadFile.Readline
sTemp = Replace (sTemp,""",""",";")
sTemp = Replace (sTemp,"""","")
MyResult = Split(sTemp,";")
lRow=lRow+1
For i = 0 To UBound(MyResult)-1
lCol=i+1
Select Case lCol
Case 6,7,8,9,15,16
If IsNumeric(MyResult(i))=False Then
objWks.cells(lRow,lCol).Value=MyResult(i)
Else
objWks.cells(lRow,lCol).Value=CCur(MyResult(i))
End If
Case Else
objWks.cells(lRow,lCol).Value=MyResult(i)
End Select
Next
Loop
objWks.columns("J:J").Insert, -4152
lRow=1
Const sQuote = """"
With objWks 'Spaltenüberschriften der neuen Excel-Datei
.cells(lRow,1).value="BelegDatum"
.cells(lRow,6).value="Betrag"
.cells(lRow,10).value="Buchungstext"
End With
Dim MyFile
Set MyFile = objFSO.OpenTextFile(sPathExport & "\Banken.csv", 2, True)
Const xlCellTypeLastCell=11
lRow=objWks.usedrange.specialcells(xlCellTypeLastCell).row
lCol=objWks.usedrange.specialcells(xlCellTypeLastCell).Column
Dim sBereich 'Sortierung neu
sBereich= GetExcelCol(1,false) & 1 & ":" & GetExcelCol(lCol,False) & lRow
objWks.Range(sBereich).Sort objWks.Range("A1"), 1,,,,,,1, 1, 1, 1, , 0
lRow = 1
Dim lColWKZ 'Währungskennzeichen
Do While lColWKZ = 0
i=i+1
If objWks.cells(lRow,i).Value="Währung" Then
lColWKZ = i
End If
Loop
For i = 2 To objWks.usedrange.specialcells(xlCellTypeLastCell).row
lRow=lRow+1
If objWks.cells(lRow,lColWKZ).value="EUR" Then 'nur EUR-Beträge
If objWks.cells(lRow,13).value<>"" Then
objWks.cells(lRow,10).value = objWks.cells(lRow,11).value & " / " & _
objWks.cells(lRow,13).value
Else
objWks.cells(lRow,10).value = objWks.cells(lRow,11).value
End If
curGeb = curGeb + CCur(objWks.cells(lRow,7)) 'Summe PayPal-Gebühren
colBank(1) = sQuote & "89999999" & sQuote 'Blz
colBank(2) = sQuote & "123456" & sQuote 'KtoNr
colBank(5) = objWks.cells(lRow,1) 'Datum Valuta
colBank(6) = objWks.cells(lRow,1) 'Buchungsdatum
colBank(7) = FormatNumber(objWks.cells(lRow,6),2) 'Umsatz
colBank(8) = objWks.cells(lRow,13) 'Auftraggebername 1
colBank(12) = objWks.cells(lRow,11) 'Verwendungszweck 1(Transaktionscode)
colBank(13) = objWks.cells(lRow,12) 'Verwendungszweck 2 (EMail)
colBank(14) = objWks.cells(lRow,3) 'Verwendungszweck 3 (Beschreibung)
colBank(29) = FormatNumber(objWks.cells(lRow,7),2) 'Gebühren
sTemp=""
For lCol=1 To UBound(colBank)
sTemp = sTemp & colBank(lCol) & ";"
Next
sTemp = Left(sTemp,Len(sTemp)-1) 'letztes Semikolon löschen
MyFile.Writeline sTemp
End If
Next
'zuletzt noch als letzte Bankbewegung die summierten PayPal-Gebühren
sTemp=""
sTemp = sTemp & sQuote & "89999999" & sQuote & ";" 'Blz
sTemp = sTemp & sQuote & "123456" & sQuote & ";" 'KtoNr
sTemp = sTemp & ";" 'Auszug
sTemp = sTemp & ";" 'Datum Auszug
sTemp = sTemp & DateSerial(Year(objWks.cells(lRow,1)),Month(objWks.cells(lRow,1))+1,0) & ";" 'Datum Valuta
sTemp = sTemp & DateSerial(Year(objWks.cells(lRow,1)),Month(objWks.cells(lRow,1))+1,0) & ";" 'Datum Buchung
sTemp = sTemp & FormatNumber(curGeb,2) & ";" 'Umsatz
sTemp = sTemp & "PayPal" & ";" 'Auftraggebername 1
sTemp = sTemp & "" & ";" 'Auftraggebername 2
sTemp = sTemp & "" & ";" 'BLZ Auftraggeber
sTemp = sTemp & "" & ";" 'Kto Auftraggeber
sTemp = sTemp & "PayPal-Gebühren" & ";" 'Verwendungszweck 1
sTemp = sTemp & "" & ";" 'Verwendungszweck 2
MyFile.Writeline sTemp
MyFile.Close
MsgBox "PayPal-Buchungen können jetzt importiert werden.",,"Export PayPal"
Private Sub UTF8toANSI(ByVal UTF8FName, ByVal ANSIFName)
Dim strText
With CreateObject("ADODB.Stream")
.Open
.Type = adTypeBinary
.LoadFromFile UTF8FName
.Type = adTypeText
.Charset = "utf-8"
strText = .ReadText()
.Position = 0
.SetEOS
.Charset = "x-ansi" 'Use current ANSI codepage.
.WriteText strText, adWriteChar
.SaveToFile ANSIFName, adSaveCreateOverWrite
.Close
End With
End Sub
' bInitialCall gibt an, ob die Zählung bei 0 (False)
' oder bei 1 erfolgen soll (bInitialCall = True)
' GetExcelCol(1,False) => A
Public Function GetExcelCol(lIdx, bInitialCall)
If (bInitialCall) Then lIdx = lIdx + 1
If (lIdx = 0) Then Exit Function
GetExcelCol = GetExcelCol((lIdx - 1) \ 26, False) + Chr(65 + (lIdx - 1) Mod 26)
End Function
'WScript.Echo GetIndexOfExcelCol("AX", 0,False)
Public Function GetIndexOfExcelCol(ByVal strCol, ByVal slevel, ByVal bInitialCall)
Dim tInitialCall
If (CInt(slevel) = Len(strCol)) Then Exit Function
If CBool(bInitialCall) = True Then
tInitialCall=-1
Else
tInitialCall=0
End if
GetIndexOfExcelCol = GetIndexOfExcelCol(strCol,CInt(slevel) + 1, False) + _
((Asc(Mid(strCol, Len(strCol) - CInt(slevel), 1)) - 65) + 1) * _
26 ^ CInt(slevel) + CLng(tInitialCall)
End Function
Im Kopfbereich des Programmcodes müssen Sie jetzt lediglich die Zeile 11:
sPathExport="C:\Users\ama\Documents\Tools"
auf ihr eigenes Exportverzeichnis ändern. Die erstellte Datei hat den Namen "Banken.csv". Diese müssen in DATEV als Importquelle (incl. Pfad) angeben.
Anschließend speichern Sie die Textdatei unter irgendeinen Namen (z. B. Convert_PayPal.txt).
Im Explorer ändern Sie die Extension von Convert_PayPal.txt -> Convert_PayPal.vbs um.
Die Extension "vbs" ist der Dateityp für ein VBSript.
Anschließend ziehen Sie einfach ihr PayPal-Kontoauszug per Drag&Drop auf das VBSript. Es wird jetzt eine Banken-Datei erstellt, die in DATEV-REWE eingelesen werden kann. Dazu müssen Sie erst eine Dummy-Bank einrichten. Ich verweise hierzu auf den Ursprungsbeitrag auf der ersten Seite. Hier habe ich alles mit Bildern u. Text beschrieben.
Wie gesagt, dass muss man einmal einrichten. Dann hat man aber keine Probleme mehr und ist alles kostenlos. 🙂
Ob sich allerdings der Aufwand in toto lohnt kann ich nicht entscheiden.
Bei Fragen einfach hier melden.
Gruß Achilleus
