Speichern Dateinamen aus Zellen

'Ergebnistabelle speichern, vorher prüfen, ob Datei schon vorhanden If Dir(StrPfad & "\" & strDateiName & ".xls*") "" Then If MsgBox("Datei: " & strDateiName & vbLf & " existiert bereits. Datei überschreiben?", _ vbQuestion + vbOKCancel, "Ergbnis-Datei speichern") = vbOK Then Application.DisplayAlerts = False wkbZiel.SaveAs Filename:=StrPfad & "\" & strDateiName, FileFormat:=52 'xlsm-Datei Application.DisplayAlerts = True End If Else wkbZiel.SaveAs Filename:=StrPfad & "\" & strDateiName, FileFormat:=52 'xlsm-Datei End If 'Temporäre Datei ohne Speichern schliessen wkbTemp.Close savechanges:=False

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Tom,
Hier dein Makroschnippsel ergänzt um eine Prüfung des Dateinamens.
Unzulässige Zeichen werden ersetzt. Bei zu langen Dateinamen wird ein Datei-Dialog angezeigt.
LG
Franz

Sub aaTest()
Dim varDateiNeu As Variant
If fncCheckFileName(varDateiNeu, strDateiName, "_", "NeueDatei") = False Then
If varDateiNeu = "NeueDatei" Or Len(varDateiNeu) > 250 Then
With Application.FileDialog(msoFileDialogSaveAs)
.ButtonName = "Auswählen"
.FilterIndex = 2 'xlsm-Datei im Standard-Excel-Dialog
.InitialFileName = varDateiNeu
If .Show = -1 Then
varDateiNeu = .SelectedItems(1)
'Pfad und Datei-Namenserweiterung wieder abtrennen
varDateiNeu = Mid(varDateiNeu, InStrRev(varDateiNeu, "\") + 1)
varDateiNeu = Left(varDateiNeu, InStrRev(varDateiNeu, ".") - 1)
strDateiName = varDateiNeu
Else
'Temporäre Datei ohne Speichern schliessen
wkbTemp.Close savechanges:=False
Exit Sub
End If
End With
Else
strDateiName = varDateiNeu
End If
End If
strDateiName = strDateiName & ".xlsm"
'Ergebnistabelle speichern, vorher prüfen, ob Datei schon vorhanden
If Dir(strPfad & "\" & strDateiName)  "" Then
If MsgBox("Datei: " & strDateiName & vbLf & " existiert bereits. Datei überschreiben?", _
vbQuestion + vbOKCancel, "Ergbnis-Datei speichern") = vbOK Then
Application.DisplayAlerts = False
wkbZiel.SaveAs Filename:=strPfad & "\" & strDateiName, FileFormat:=52  'xlsm-Datei
Application.DisplayAlerts = True
End If
Else
wkbZiel.SaveAs Filename:=strPfad & "\" & strDateiName, FileFormat:=52  'xlsm-Datei
End If
'Temporäre Datei ohne Speichern schliessen
wkbTemp.Close savechanges:=False
End Sub
Public Function fncCheckFileName(ByRef varFile As Variant, ByVal strFileName As String, _
Optional ByVal strReplace As String = "_", _
Optional strFileBlanc = "DateiNeu") As Boolean
'Das Makro prüft den Text strFileName, ob er ein zulässiger Dateiname ist
'Die unzulässigen Zeichen werden durch das Zeichen strReplace ersetzt und der neue  _
Dateiname _
in der Variablen varFile zurückgegeben
'Enthält der Text nur Leerzeichen, (" ") dann wird der optionale Wert strFileBlanc _
als Dateiname zurückgegeben
Dim arrZeichen, intZ As Integer, strFileNew As String
'unzulässige Zeichen für Dateinamen
'Bei Bedarf kann man die Liste um weitere Zeichen erweitern, die nicht im Dateinamen _
vorhanden sein sollen
arrZeichen = Array("""", "'", "/", "\", ":", "[", "]", ">", " 0 Then
strFileNew = VBA.Replace(strFileNew, arrZeichen(intZ), strReplace)
End If
Next
varFile = strFileNew
fncCheckFileName = strFileNew = strFileName
If Len(strFileNew) > 250 Then
fncCheckFileName = False
MsgBox "Der Dateiname ist zu lang!", vbOKOnly, "Prüfung Dateiname2"
End If
End If
End Function

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Speichern Dateinamen aus Zellen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread