Nachfrage code
14.03.2016 18:42:56
Guesa
Von Rudi habe ich diesen Code bekommen. Bei mir, 2007, läuft es ohne Probleme jetzt wollte ich diesen auf meinem Arbeitsrechner, 2010, mit einbauen, dort bricht er immer ab. Nach einigem ausprobieren, bekomme immer Fehlermeldungen "Dateiname Falsch" "Fehler 51", habe ich entnervt aufgegeben. Letzte Rettung hier im Forum, würde mich über jede Hilfe freuen. Die beschriebenen Zellen sind im Übrigen verkettet, ich denke damit hat 2010 so seine Probleme?
Danke schon mal vorab
Gruß, Guesa
Sub Speichern()
Dim wb As Workbook
Dim strFileName As String
On Error GoTo ErrorHandler
Application.DisplayAlerts = False
With ThisWorkbook.Worksheets("BerStempel")
Call OrdnerPruefen(.Range("P1"))
strFileName = .Range("P1") & "\" & .Range("P2")
End With
ActiveSheet.Copy
With ActiveWorkbook
.SaveAs strFileName, FileFormat:=51
'Oder als xls
'.SaveAs strFileName, FileFormat:=-4143
.Sheets(1).Shapes("speichern1").Delete
.Close True
End With
ErrorHandler:
If Err.Number > 0 Then MsgBox Err.Description, , "Fehler: " & Err.Number
Application.DisplayAlerts = True
Call Rech_Nr
End Sub
Sub OrdnerPruefen(s As String)
Dim fs As Object, t, i As Integer, f As String
Set fs = CreateObject("scripting.filesystemobject")
If Not fs.folderexists(s) Then
t = Split(s, "\")
f = t(0)
For i = 1 To UBound(t)
f = f & "\" & t(i)
If Not fs.folderexists(f) Then fs.createfolder (f)
Next i
End If
Set fs = Nothing
End Sub