Wenn ich deine obige Makro reinkopiere erhalte ich einen Syntaxfehler beim End Sub<strong>
Was macht das?
Ich muss schon alle 27 Zeilen von dir in mein Makro kopieren und meine weiteren dazu?
Also so?
Public Sub SaveSpecial()
Dim sPath1 As String, sPath2 As String
sPath1 = "L:\01_Projekte_#\01_Auftragsordner_#\"
sPath2 = "\\10.10.100.0\Exchange\Projekte_#\"
Call SaveSpecial_mod(sPath1)
Call SaveSpecial_mod(sPath2)
End Sub<strong>
</strong>
Public Sub SaveSpecial_mod(sPath As String)
'Const FOLDER_PATH As String = "L:\01_Projekte_#\01_Auftragsordner_#\"
<strong> </strong>Dim lngYear As Long, lngReturn As Long
Dim strFolder As String, strSubFolder As String, strValue As String, strFile As String
Dim blnFound As Boolean
strValue = Split(Cells(2, 10).Text, "-")(0)
strFile = Cells(2, 10).Text
For lngYear = Year(Date) - 1 To Year(Date) + 1
strFolder = Replace(sPath, "#", CStr(lngYear))
lngReturn = MakeSureDirectoryPathExists(strFolder)
If lngReturn = 0 Then
Call MsgBox("Ordner kann nicht erstellt werden.", vbCritical, "Dateisystemfehler")
Exit Sub
Else
strSubFolder = Dir$(strFolder & strValue & "*", vbDirectory)
If strSubFolder <> vbNullString Then
If InStr(1, ThisWorkbook.Name, "_") = 0 Then
strFile = strFile & "_" & ThisWorkbook.Name
Else
strFile = strFile & Mid$(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, "_"))
End If
Call ThisWorkbook.SaveAs(Filename:=strFolder & strSubFolder & "\" & _
strFile, FileFormat:=xlOpenXMLWorkbookMacroEnabled)
blnFound = True
Exit For
End If
End If
Next
If Not blnFound Then _
Call MsgBox("Ordner ''" & strValue & "'' nicht gefunden.", _
vbCritical, "Datei nicht gespeichert")
End Sub
|