bijlage automatisch verplaatsen naar server locatie?

[Kacik]

Goedmiddag,

Ik heb gevonden mooi scrip voor verplaatsen bijlagen van mail naar server locatie. Hij werk. enige wat gaat fout is dat hij ziet geen bestaand. Is het mogelijk deze zo ombouwen dat hij specifiek naar een bestand gaat kijken? (bv. Artur.xlsx) en deze dan verplaatsen? Elke help is welkom.
Alvast bedankt.

Sub SaveAttachmentsToFolder()
' This Outlook macro checks a named subfolder in the Outlook Inbox
' (here the "Sales Reports" folder) for messages with attached
' files of a specific type (here file with an "xls" extension)
' and saves them to disk. Saved files are timestamped. The user
' can choose to view the saved files in Windows Explorer.
' NOTE: make sure the specified subfolder and save folder exist
' before running the macro.
    On Error GoTo SaveAttachmentsToFolder_err
' Declare variables
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim SubFolder As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Dim varResponse As VbMsgBoxResult
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set SubFolder = Inbox.Folders("OBI-Agent") ' Enter correct subfolder name.
    i = 0
    
' Check subfolder for messages and exit of none found,
    If SubFolder.Items.Count = 0 Then
        MsgBox "There are no messages in the Sales Reports folder.", vbInformation, _
               "Nothing Found"
        Exit Sub
    End If
    
' Check each message for attachments,
    For Each Item In SubFolder.Items
        For Each Atmt In Item.Attachments
        
' Check filename of each attachment and save if it has "xlsx" extension,
            If Right(Atmt.FileName, 3) = ".xlsx" Then
            ' This path must exist! Change folder name as necessary,
                FileName = "N:\Logistiek\Algemeen\My Dear\Database\PackMe\" & _
                    Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
                Atmt.SaveAsFile FileName
                i = i + 1
            End If
        Next Atmt
    Next Item
    
' Show summary message,
    If i > 0 Then
        varResponse = MsgBox("I found " & i & " attached files." _
        & vbCrLf & "I have saved them into the N:\Logistiek\Algemeen\My Dear\Database\PackMe" _
        & vbCrLf & vbCrLf & "Would you like to view the files now?" _
        , vbQuestion + vbYesNo, "Finished!")
        
' Open Windows Explorer to display saved files if user chooses,
        If varResponse = vbYes Then
            Shell "Explorer.exe /e,N:\Logistiek\Algemeen\My Dear\Database\PackMe", vbNormalFocus
        End If
    Else
        MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
    End If
    
' Clear memory
SaveAttachmentsToFolder_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
    
' Handle Errors
SaveAttachmentsToFolder_err:
    MsgBox "An unexpected error has occurred." _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: GetAttachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume SaveAttachmentsToFolder_exit
End Sub

 

[edmoor]

Dat staat hier toch?
If Right(Atmt.FileName, 3) = ".xlsx" Then

Daar maak je dan dit van:
If Atmt.FileName = "Artur.xlsx" Then

 

[Kacik]

ja, dat klopt. maar ik krijg wel melding:"I didn't find any attached files in your mail.". En zekker zit de bestandje erin.
ik wet niet waar lopt fout:shocked:

 

[edmoor]

Ik ook niet als je de code zoals je deze nu hebt niet laat zien.

 

[Kacik]

Bedankt voor help. Gelukkig is dit niet meer nodig. Wij hebben andere oplossing gevonden.