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

Pfad und Dateiname aus Zelle

Pfad und Dateiname aus Zelle
05.10.2014 20:23:17
WalterK
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 

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pfad und Dateiname aus Zelle
05.10.2014 20:39:08
Daniel
Hi
welche Werte haben denn die Variablen, wenn der Fehler auftritt?
Die Werte sollten in einer Bubblehelp angezeigt werden, wenn du mit der Maus im Code über den Variablennamen fährst, nachdem der Fehlerabbruch erfolgt ist?
Die Variablen sind sFile_Name und varIndex.
Gruß Daniel

AW: Pfad und Dateiname aus Zelle
05.10.2014 20:49:36
WalterK
Hallo Daniel,
ich verstehe nicht was ich machen soll.
Hier eine Beispieldatel. Ich hatte sie nur vergessen mit zu senden.
https://www.herber.de/bbs/user/92976.xlsm
Danke und Servus, Walter

AW: Pfad und Dateiname aus Zelle
05.10.2014 21:55:43
Daniel
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

Anzeige
AW: Pfad und Dateiname aus Zelle
05.10.2014 22:56:30
WalterK
Hallo Daniel,
wenn ich mich in VBA besser auskennen würde, müsste ich nicht fragen.
Wenn es Anhand einer Beispieldatei und eines Makros nicht möglich ist mein Anliegen zum Laufen zu bringen, dass soll es eben nicht sein.
Servus, Walter

AW: Pfad und Dateiname aus Zelle
05.10.2014 23:11:52
Daniel
ich hab dir doch beschrieben, wie du deine Datei ans laufen bringst:
1. den von dir auskommentierten Codeteil wieder aktiveren, dh die Hochkommas rausnehmen
2. den Dateinamen in der Zelle zukünftig mit der Dateierweiterung eingeben, dh nicht nur "Mustermann", sonden "Mustermann.xlsx"
ausserdem ist es, wenn du fragen zu eienm bestimmten Code hast immer besser denjenigen zu fragen, der den Code geschrieben hat.
Der kann dir dann besser sagen, woran es liegt und der weiss sicherlich auch, wie man den Dateinamen eingeben muss.
Gruß Daniel

Anzeige
AW: Pfad und Dateiname aus Zelle
05.10.2014 21:39:00
Falo
Hallo Walter,
verstehe ich das richtig das du den Datei Name mit Pfad in eine Zelle schreiben?
wenn ja versuch es mal hiermit
Es wird ein datei Dialog geöffnet und den kommpletten Pfad in Zelle A1 geschrieben
LG
Olaf
Sub Pfadschreiben()
With Application.FileDialog(msoFileDialogFilePicker)
If .Show = -1 Then
Range("a1") = .SelectedItems(1)
End If
End With
End Sub

AW: Pfad und Dateiname aus Zelle
05.10.2014 23:00:37
WalterK
Hallo Olaf,
eigentlich meinte ich es gerade umgekehrt.
Ich will in 1 Zelle den Pfad vorgeben und in 1 anderen Zelle den Namen der Datei. Und dann soll wenn ich "Speichern untern" wähle oder auch nur "Speichern" beim Speichern-Dialog gleich der richtige Ordner vorgegeben sein und und auch gleich der richtige Dateiname vorgeschlagen werden.
Danke für Deine Hilfe und Servus, Walter
Anzeige

256 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige