Datei speichern in Pfad
02.02.2021 12:33:26
Thomas
Ich habe ein Problem beim speichern einer Datei in einem Pfad.
Sowohl der Pfad als auch die Datei werden korrekt angelegt nur leider wird die Datei nicht IN das Verzeichnis gelegt sondern immer nur "daneben"...
Für euch sicherlich ein lächerliches Problem, für mich aktuell aber ein unüberwindbaren Hindernis :(
Hier mein verwendeter code:
Sub speichern()
' speichern Makro
' Tastenkombination: Strg+p
' speichert die datei
Dim strFilename As String
Dim strOrdner As String, varOrdner, i As Integer, strZeichen As String
strOrdner = "C:\Users\tages\Documents\Test Makro\" & "PG" & ActiveSheet.Range("D8") & " " & _
_
_
ActiveSheet.Range("D1") & " " & ActiveSheet.Range("D2") & " " & ActiveSheet.Range("D3").Text
varOrdner = Split(strOrdner, "\")
strOrdner = varOrdner(0)
For i = 1 To UBound(varOrdner)
If fncheckFoldername(varOrdner(i)) Then
strOrdner = strOrdner & Application.PathSeparator & varOrdner(i)
If Dir(strOrdner, vbDirectory) = "" Then
VBA.MkDir Path:=strOrdner
End If
Else
MsgBox "Der Unter-Ordner """ & varOrdner(i) _
& """ enthält unzulässige Zeichen ( : / \ | * ? oder "" )", _
vbOKOnly, "Prüfung Ordnername"
Exit Sub
End If
Next i
strFilename = ActiveSheet.Range("C77").Text & ".xlsm"
If fncheckFilename(strFilename, strZeichen) Then
If Dir(strOrdner & "\" & strFilename) "" Then
If MsgBox("vorhandene Datei: " & strFilename & vbLf & "im Ordner: " & strOrdner & _
vbLf _
& "überschreiben?", vbQuestion + vbOKCancel, "Datei speichern") = vbOK Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strOrdner & "\" & strFilename, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.DisplayAlerts = True
End If
Else
ActiveWorkbook.SaveAs Filename:=strOrdner & " " & Format(Date, "YYYY-MM-DD"), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
Else
MsgBox "Der Dateiname """ & strFilename _
& """ enthält unzulässige Zeichen " & strZeichen, _
vbOKOnly, "Prüfung Dateiname"
End If
End Sub
Function fncheckFilename(ByVal strName, Optional strZ As String) As Boolean
Dim arrZeichen
Dim i As Integer
arrZeichen = Array(":", "/", "\", "|", """", "?", "*", "")
fncheckFilename = True
For i = LBound(arrZeichen) To UBound(arrZeichen)
If InStr(1, strName, arrZeichen(i)) > 0 Then
strZ = strZ & " " & arrZeichen(i)
End If
Next
If strZ "" Then fncheckFilename = False
End Function
Function fncheckFoldername(ByVal strName, Optional strZ As String) As Boolean
Dim arrZeichen
Dim i As Integer
arrZeichen = Array(":", "/", "\", "|", """", "?", "*", "")
fncheckFoldername = True
For i = LBound(arrZeichen) To UBound(arrZeichen)
If InStr(1, strName, arrZeichen(i)) > 0 Then
strZ = strZ & " " & arrZeichen(i)
End If
Next
If strZ "" Then fncheckFoldername = False
End Function
Vielen Dank im Voraus TB
