Guten Tag

Kann bei folgedem Makro ein zweiter Dateipfand (\\10.10.100.0\Exchange\Projekte) eingefügt werden das es an beiden Orten nach dem Dateiornder sucht?

Wo müsste dies eingefügt werden?

Freue mich auf eure Hilfe.

Gruss 

ch79

Option Explicit

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal DirPath As String) As Long

Public Sub SaveSpecial()

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(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