Speichern unter aus Makro entfernen

'Dialog zur Eingabe eines Dateinamens
namecsv = ""
Do While namecsv = ""
namecsv = Application.GetSaveAsFilename( _
filefilter:="CSV-Dateien (*.csv), *.csv")
Loop

Sub csv
Dim beldat As String
Dim belart As String
Dim bukrs As String
Dim budat As String
Dim periode As String
Dim waehrung  As String
Dim referenz As String
Dim kopfzeile As String
Dim zeile1 As String
Dim zeile2 As String
Dim kos As String
Dim koh As String
Dim sts As String
Dim sth As String
Dim ksts As String
Dim ksth As String
Dim bwas As String
Dim bwah As String
Dim betrag As String
Dim zuord As String
Dim postext As String
Dim header As String
Dim strech As String
buschs = "40"
buschh = "50"
strech = "X"
' !. Zeile in CSV-Datei definieren
header = "Belegdatum;Belegart;Buch.kreis;Buch.datum;Buch.periode;Währung;"
header = header & "Referenz;Buch.schl.;Konto;Betrag;Steuerkennz.;Kostenstelle;"
header = header & "Zuordnung;Text;Steuer rechnen;Zlg.bedingung;Zahlsperre;"
header = header & "BWA LC-AA / RSt;PG;SHB;Zahlweg;Basisdatum;Barcode"
' Merken aktuellen Dateinamen
pfad = ActiveWorkbook.Path
Name = ActiveWorkbook.Name
newname = "Meldung Lohnverst. Jan. 2016"
'Dialog zur Eingabe eines Dateinamens
namecsv = ""
Do While namecsv = ""
namecsv = Application.GetSaveAsFilename( _
filefilter:="CSV-Dateien (*.csv), *.csv")
Loop
Open namecsv For Output As #1
Print #1, header
i = 2   'Zähler Usprungsdatei
' Quellsheet verarbeiten
Do While Cells(i, 2)  ""
beldat = ""
belart = ""
bukrs = ""
budat = ""
periode = ""
waehrung = ""
referenz = ""
kopfzeile = ""
zeile1 = ""
zeile2 = ""
kos = ""
koh = ""
sts = ""
sth = ""
ksts = ""
ksth = ""
bwas = ""
bwah = ""
betrag = ""
zuord = ""
postext = ""
' Einzelwerte einlesen
If Cells(i, 1) = "" Then       ' Wenn Wert = X soll die Zeile nicht verarbeitet werden
beldat = Cells(i, 4)
Do While InStr(beldat, ".")  0    'Aus Belegdatum die Punkte entfernen
beldat = Left(beldat, InStr(beldat, ".") - 1) & Right(beldat, (Len(beldat) - InStr(  _
_
_
beldat, ".")))
Loop
belart = Cells(i, 5)
bukrs = Cells(i, 2)
budat = Cells(i, 6)
Do While InStr(budat, ".")  0     'Aus Buchungsdatum die Punkte entfernen
budat = Left(budat, InStr(budat, ".") - 1) & Right(budat, (Len(budat) - InStr(budat, _
_
_
".")))
Loop
periode = Cells(i, 7)
waehrung = Cells(i, 8)
referenz = ""
kopfzeile = beldat & ";" & belart & ";" & bukrs & ";" & budat & ";" & periode & ";" &    _
_
_
waehrung & ";" & referenz & ";"
kos = Cells(i, 9)
koh = Cells(i, 13)
sts = Cells(i, 12)
sth = Cells(i, 16)
' Kostenstelle zusammensetzen
If Cells(i, 11)  "" Then
ksts = bukrs & Cells(i, 11)
End If
If Cells(i, 15)  "" Then
ksth = bukrs & Cells(i, 15)
End If
bwas = Cells(i, 10)
bwah = Cells(i, 14)
betrag = Cells(i, 17)
zuord = Left(Cells(i, 18), 18)
postext = Left(Cells(i, 19), 50)
zeile1 = buschs & ";" & kos & ";" & betrag & ";" & sts
' Erzeugen zeilen in CSV-Datei
' Wenn Steuerkennzeichen = V0, dann nicht Steuer rechnen aktivieren
' Wenn Steuerkennzeichen  V0 und beide Steuerkennzeichen sind gleich, dann auch
' Steuer rechnen nicht archivieren
If sts  "V0" Then
If sts = sth Then
zeile1 = zeile1 & ";" & ksts & ";" & zuord & ";" & postext & ";;;;" & bwas & ";; _
_
_
Else
zeile1 = zeile1 & ";" & ksts & ";" & zuord & ";" & postext & ";X;;;" & bwas & "; _
_
_
End If
Else
zeile1 = zeile1 & ";" & ksts & ";" & zuord & ";" & postext & ";;;;" & bwas & ";;;;;" _
_
_
End If
zeile2 = buschh & ";" & koh & ";" & betrag & ";" & sth
zeile2 = zeile2 & ";" & ksth & ";" & zuord & ";" & postext & ";;;;" & bwah & ";;;;;"
' Schreiben der Daten in die vorher angegebene Datei
Print #1, kopfzeile & zeile1
Print #1, ";;;;;;;" & zeile2
End If
i = i + 1
Loop
Close #1
Workbooks("Meldung Lohnverst. Jan. 2016.xls").Close SaveChanges:=False
Kill "C:\Neuer Ordner\Meldung Lohnverst. Jan. 2016.xls"
End Sub