das ist ein Ausschnitt von einem längeren Makro was ich zurzeit versuche zu schreiben. Dieser Part stammt jedoch von einem unbekannten Vorgänger...
Hab das Makro kopiert und eingefügt...
Passt auch alles wunderbar, jedoch möchte ich gerne die "Speichern unter" Abfrage umgehen und ihm direkt vorgeben:
Dateiname = Meldung Lohnverst. Jan. 2016
Dateityp = csv
Ich habe die betreffende Zeile mal fett markiert..
Versucht habe ich schon einiges, aber er führt das Makro nach dem ändern der Zeile nicht mehr korrekt aus.
Ziel ist es aus einer .xls Datei eine .csv Datei in bestimmter Form zu erhalten.
Kann jmd. bitte weiterhelfen?
Vielen Dank.
Grüße
John
'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
https://www.herber.de/bbs/user/107806.zip