Pfad wird nicht angelegt
24.08.2017 22:41:51
Stefan
ich mal wieder ein weiteres Problem.
Wenn ich die Ordner manuell anlegen schreibt er mir die CSV sauber rein,
sobald ich den Ordner lösche und von EXCEL anlegen lassen will sagt er mir PFAD NICHT VORHANDEN. Was mach ich falsch ?
Sub SpeichernBestand()
Dim datei As String, Text As String
Dim Zeile As Long
Dim pfad As String
Dim name As String
Dim letztezeile As Integer
On Error GoTo Fehler
Dim Fileformat As Object
Dim oname As String
Dim vdatei As String
Dim a As String
Dim jahr As Integer
Dim monat As String
jahr = Format(Now, "YYYY")
monat = Format(Now(), "Mmmm")
oname = "IST_Bestand" & "\"
AktuellesDatum = Date
pfad = ThisWorkbook.Path & "\"
name = "IST-Bestand am "
vdatei = pfad & oname & "\" & jahr & "\" & monat & "\"
datei = vdatei & name & Date & " um " & Format(Now, "HH.MM") & " Uhr" & ".csv"
letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set fs = CreateObject("Scripting.FileSystemObject")
If Dir(pfad & oname, vbDirectory) = "" Then MkDir pfad & oname
If fs.folderexists(vdatei) Then
GoTo schreiben
Else
a = MsgBox("Ordner " & vdatei & " nicht gefunden!" & vbLf & "Ordner anlegen?", _
vbQuestion + vbYesNo, "Frage")
If a = vbYes Then MkDir (vdatei)
GoTo schreiben
schreiben:
Application.DisplayAlerts = False
Open (datei) For Output As #1 'Zieldatei öffnen
For Zeile = 1 To letztezeile
'reinschreiben
Print #1, Cells(Zeile, 1) & ";" & Cells(Zeile, 2) & ";" & Cells(Zeile, 3) & ";" & Cells(Zeile, _
_
4) & ";" & Cells(Zeile, 5) & ";" & Cells(Zeile, 6) & ";" & Cells(Zeile, 7) & ";" & Cells(Zeile, _
8) & ";" & Cells(Zeile, 9) & ";" & Cells(Zeile, 10) & ";" & Cells(Zeile, 11) & ";" & Cells( _
Zeile, 12) & ";" & Cells(Zeile, 18) & ";"
Next Zeile
Close #1 'Zieldatei schließen
Application.DisplayAlerts = True
Exit Sub
Fehler:
Close #1
MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, "Fehler"
'End If
End If
End Sub