Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Speichern Dateinamen aus Zellen

Speichern Dateinamen aus Zellen
22.02.2017 11:56:57
Tom
Hallo zusammen,
beim Anlegen einer Datei wird der Dateinamen aus einzelnen Zellen zusammengefügt und auf dem Server abgespeichert. Wenn der Name aber länger ist und Sonderzeichen enthält, wird keine Datei mit der xls* Endung erzeugt. Es wird nur eine Systemdatei abgelegt die dann auf xlsm umbenannt werden muss.
Wie lässt sich die Formel anpassen, damit die Sonderzeichen erkannt und nicht beachtet werden? Bzw. es wäre schön wenn in diesen Fällen sich ein Speicherfenster öffnen würde um den Dateinamen manuell eingeben zu können. Alternativ wäre es auch i.O. wenn sich das Speicherfenster immer öffnen würde und der Dateiname individuell abgeändert werden kann.
Wie lässt sich das ganze am einfachsten darstellen?
Bitte um Unterstützung.
Danke & Gruß Tom
  '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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Speichern Dateinamen aus Zellen
23.02.2017 00:32:32
fcs
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

Anzeige

323 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige