AW: Hauptordner-Unterordner-Dateiname
04.01.2018 14:33:54
fcs
Hallo Hans,
es gibt Zeichen, die für Dateinamen und Ordner nicht zulässig sind: : / \ | * ? < > und "
Das muss man vor dem Speichern/anlegen eines Ordner prüfen,um den Fehler zu vermeiden.
Bevor du einen neuen Ordner anlegst, musst du prüfen,ob er schon vorhanden ist.
Falls mehrere Unterordner möglich sind muss die gesamte Struktur geprüft und angelegt werden.
Du musst für den Dateinamen also das Format für die Uhrzeit ohne Doppelpunkt einbauen bzw. ein anderes Zeichen verwenden. Etwa wie folgt:
Gruß
Franz
Tabelle1
| | B | C |
| 66 | Prüfername | Meier |
| 67 | Straße | Marienplatz |
| 68 | Hausnummer | 22a |
| 69 | | |
| 70 | | |
| 71 | | |
| 72 | Ort | Kiel |
| 73 | Datum | 04.01.2018 |
| 74 | Uhrzeit | 15:30 |
| 75 | | |
| 76 | | |
| 77 | Dateiname | Meier-Kiel-Marienplatz-22a-04.01.2018-15_30 |
| 78 | | |
| 79 | | |
| 80 | Unterordner | Kiel_04.01.2018 |
| 81 | | |
| Formeln der Tabelle |
| Zelle | Formel | | C77 | =C66&"-"&C72&"-"&C67&"-"&C68&"-"&TEXT(C73;"TT.MM.JJJJ")&"-"&TEXT(C74;"hh""_""mm") | | C80 | =C72&"_"&TEXT(C73;"TT.MM.JJJJ") |
|
Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
angepasstes Makro zum Speichern:
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:\Test\" & ActiveSheet.Range("C80").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 & "\" & strFilename, _
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