Laufzeitfehler 1004

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
Sub angebot_speichern()
' angebot_speichern Makro
' speichert Angebot
Dim Dateiname As String, Ordner As String, s As String, datTyp As String
Dim result As Long, i As Integer
Sheets("HAngebot").Activate
Dateiname = Trim(Range("N18").Value & ".xlsm")
Ordner = Trim(Range("N16").Value)
If Right(Ordner, 1)  "" Then
'wichtig f?r 'MakeSureDirectoryPathExists'
'sonst wird das letzte Sub-Directory nicht erzeugt
Ordner = Ordner & ""
End If
If Dir(Left(Ordner, 3) & "*.", vbDirectory) = "" Then
'pr?fen, ob das vorgeschlagene Laufwerk existiert
'z.B.: Y:
MsgBox "Das Laufwerk '" & UCase(Left(Ordner, 1)) & "* existiert nicht!", _
vbSystemModal + 16
Exit Sub
End If
If Dir(Ordner, vbDirectory) = "" Then
'statt MkDir
'vorgeschlagenen Ornder anlegen (einschlie?lich aller Unterordner)
MakeSureDirectoryPathExists Ordner
While Dir(Ordner, vbDirectory) = ""
'warten, bis Ordner vom Betriebssystem erstzellt wurde
'dieser Proze? hat aber eine niedrige Priorit?t
DoEvents
Wend
End If
'voller Dateiname einschlie?lich Pfad
s = Ordner & Dateiname
'Position letzter Punkt im Dateinamen
i = InStrRev(s, ".", -1, vbTextCompare)
'Dateityp vom vollen Dateinamen abh?ngen
s = Left(s, i - 1)
'Dateityp merken
datTyp = Mid(s, i) & ".xlsm"
For i = 2 To 200
'_2, _3,_4 usw. an den eigentlichen Dateinamen (ohne Dateityp)
'anh?ngen
If Dir(s & datTyp, vbNormal) = "" Then
'wenn es den neu gebildeten Dateinamen nicht gibt, dann raus aus der For-Schleife
Exit For
End If
Next i
'jetzt speichern mit neuem Dateinamen
ActiveWorkbook.SaveAs Filename:=s & datTyp, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Sub Ablage()
' Ablage des Dokuments
Dim Dateiname As String, Ordner As String, s As String, datTyp As String
Dim result As Long, i As Integer
Sheets("HAngebot").Activate
Ordner = Trim(Range("N16").Value)
Dateiname = Trim(Range("N18").Value)
s = Ordner & Dateiname
If Dir(s) = "" Then
ActiveWorkbook.SaveAs Filename:=s & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
MsgBox "Datei schon vorhanden"
End If
End Sub