Die Änderung habe ich gesehen und ausmarkiert. Funktioniert leider trotzdem nicht. Kann es auch daran liegen das nicht beide Pfade gleich aufgebaut sind?
sPath1 = "L:\01_Projekte_#\01_Auftragsordner_#\"
sPath2 = "\\10.10.100.0\Exchange\Projekte_#\"
Beim ersten sucht er ja nach dem entsprechenden Jahr zur Ablage ab, was beim 2. entfällt. Da gibt es nur den Exchangeordner und dann den Projektordner.
Wie würde das Makro aussehen wen ich nur mit Pfad 2 arbeite?
Option Explicit
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
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
Public Sub SaveSpecial_mod(sPath As String)
'Const FOLDER_PATH As String = "L:\01_Projekte_#\01_Auftragsordner_#\"
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))
'strFolder = Replace(FOLDER_PATH, "#", 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
|