Pfad und Dateiname aus Zelle

Hallo und schönen Abend,
den folgenden Code habe ich im Internet gefunden, er sollte eine Datei nach Vorgabe des Pfades und des Dateinamens (aus 2 bestimmten Zellen) die Datei entsprechend speichern.
Bei den Zeilen:

    If Val(Application.Version) > 11 Then
sFile_Name = Application.GetSaveAsFilename(sFile_Name, _
"Excel Arbeitsmappe ohne VBA (*.xlsx),*.xlsx," & _
"Excel Arbeitsmappe mit Makros (*.xlsm),*.xlsm," & _
"Excel Binärarbeitsmappe (*.xlsb),*.xlsb," & _
"Excel 97-2003 Arbeitsmappe (*.xls),*.xls", varIndex, "Speichern unter")

... kommt allerdings der Laufzeitfehler 13: Typen unverträglich
Wer kann mir hier weiterhelfen?
Danke und Servus, Walter
Hier der gesamte Internet-Auszug:
kommt als Code in DieseArbeitsmappe

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim strPfad$, strFileName$
Dim sFile As String
'Pfad Vorgabe
strPfad = "D:\Bilder\"
'Dateiname (hier aus A1 evtl. Tabelle anpassen)
strFileName = Sheets("Tabelle1").Range("A1")
sFile = Speichern_Unter(strFileName, strPfad)
If sFile  "" Then
MsgBox "Datei wurde gespeichert unter" & vbCr & sFile, vbInformation
Else
MsgBox "Datei wurde nicht gespeichert unter neuen Namen/Pfad gespeichert", vbExclamation
End If
End Sub

kommt als Code in Modul

Option Explicit
'Function Dialog Speichern unter *************************************************************** _
Function Speichern_Unter(Optional ByRef sFile_Name As String, Optional ByVal sPath As String)  _
As String
Dim ArrFileFormat, varIndex, sExtension$, iFileFormat%
Dim SaveR
'Extension der Datei
sExtension$ = Right$(sFile_Name, Len(sFile_Name) - InStrRev(sFile_Name, "."))
ArrFileFormat = Array("xlsx", "xlsm", "xlsb", "xls") 'Datei Versionen
varIndex = Application.Match(sExtension, ArrFileFormat, 0) 'Index für Dialog und Angabe
'ist Angabe eine Excel Datei?
If IsError(varIndex) Then
MsgBox "kein Excel- Datei vbCr & sFile_Name, vbExclamation"
Exit Function
End If
'Ordner da?
If sPath = "" Then sPath = ThisWorkbook.Path
If sPath = "" Then sPath = Application.DefaultFilePath
If Dir(sPath, vbDirectory) = "" Then
MsgBox "Ordner exestiert nicht", vbCritical
Exit Function
End If
'Wechselt das aktuelle Laufwerk.
ChDrive Left$(sPath, 2)
'Wechselt das aktuelle Verzeichnis oder den aktuellen Ordner
ChDir sPath
'Dialog aufrufen
If Val(Application.Version) > 11 Then
sFile_Name = Application.GetSaveAsFilename(sFile_Name, _
"Excel Arbeitsmappe ohne VBA (*.xlsx),*.xlsx," & _
"Excel Arbeitsmappe mit Makros (*.xlsm),*.xlsm," & _
"Excel Binärarbeitsmappe (*.xlsb),*.xlsb," & _
"Excel 97-2003 Arbeitsmappe (*.xls),*.xls", varIndex, "Speichern unter")
ElseIf sExtension$ = "xls" Then
sFile_Name = Application.GetSaveAsFilename(sFile_Name, _
"Excel Arbeitsmappe (*.xls),*.xls", 1, "Speichern unter")
Else
MsgBox "Extension kann mit dieser Excel- Version nicht gespeichert werden!",  _
vbCritical
Exit Function
End If
'Dialog abgebrochen!
If sFile_Name = CStr(False) Then Exit Function
'nochmal Abfragen fals im Dialog geändert
sExtension$ = Right$(sFile_Name, Len(sFile_Name) - InStrRev(sFile_Name, "."))
'Formatabfrage
iFileFormat = File_Format(sExtension$)
If iFileFormat = 0 Then
MsgBox "Auswahl ist kein Excel File!", vbCritical
Exit Function
End If
'welche Excelversion
On Error GoTo Error_Handler:
If Val(Application.Version) > 11 Then
'Datei im richtigen Format speichern
ActiveWorkbook.SaveAs sFile_Name, iFileFormat
ElseIf iFileFormat = 56 Then
'bis Version 11, speichern als *.xls
ActiveWorkbook.SaveAs sFile_Name
Else
MsgBox "Extension kann mit dieser Excel- Version nicht gespeichert werden!", vbCritical  _
Exit Function
End If
Error_Handler:
If Err.Number  0 Then
Speichern_Unter = sFile_Name
Else
MsgBox Err.Description, vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, _
Err.HelpFile, _
Err.HelpContext
End If
End Function
'Funktion zum ermitteln des Dateiformats ab xl2007
Private Function File_Format(sExtension$)
Select Case LCase(sExtension$)
Case "xlsx": File_Format = 51
Case "xlsm": File_Format = 52
Case "xlsb": File_Format = 50
Case "xls": File_Format = 56
End Select
End Function

Einfach nur mir sagen, welchen Wert die Variablen haben, wenn der Fehler auftritt.
Sollte jetzt nicht so schwer sein.
Außerdem gibt es noch einen unterschied zwischen deiner Datei und dem Code den du uns gezeigt hast.
In deiner Datei sind folgende Zeilen des Codes auskommentiert, dh sie werden übersprungen.
Das darf aber nicht sein, weil sie überprüfen, ob ein gültiger Dateiname eingegeben wurde.
Gültig heißt in diesem Fall inklusive der Dateierweiterung .xlsx, .xlsm, .xlsb oder .xls.
Diese ist für das Makro erforderlich, weil es ja wissen muss, wie die Datei gespeichert werden soll.
Daher muss dieser Teil des Codes aktiv sein (ohne Hochkomma davor).
Function Speichern_Unter(Optional ByRef sFile_Name As String, Optional ByVal sPath As String) As String
...
...
'ist Angabe eine Excel Datei?
If IsError(varIndex) Then
MsgBox "kein Excel- Datei vbCr & sFile_Name, vbExclamation"
Exit Function
End If
...
...
Gruß Daniel

Forumthread: Pfad und Dateiname aus Zelle

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial