[VBA/Oulook] datum van opslaan bijlagen

[Verwijderd]

Hoi,

ik gebruik onderstaande macro om snel bijlagen op te slaan in bepaalde mappen.
nu komt na het opslaan in de map bij 'gewijzigd op' de datum van verzenden te staan ipv de datum van opslaan.
Ik wil juist dat de datum van opslaan gebruikt wordt net als dat ik het bestand handmatig zou oplsaan.

is dit te vangen in de macro?

code:

Option Explicit 
Public Sub saveAttachToDisk() 
     
    Dim objAtt As Outlook.Attachment 
    Dim olMsg As Outlook.MailItem 
    Dim strDate As String 
    Dim strName As String 
    Dim lngAns As Long 
    Dim oFrm As UserForm1 
    Const saveFolder1 As String = "C:\Temp\Test1\" 
    Const saveFolder2 As String = "C:\Temp\Test2\" 
    Const saveFolder3 As String = "C:\Temp\Test3\" 
     
     
    On Error Resume Next 
    Set olMsg = ActiveExplorer.Selection.Item(1) 
    For Each objAtt In olMsg.Attachments 
        Set oFrm = New UserForm1 
        With oFrm 
            .Caption = "Select Save Option" 
            .CommandButton1.Caption = "Doorgaan" 
            .CommandButton2.Caption = "Opslaan afbreken" 
            .TextBox1.Text = objAtt.FileName 
            .OptionButton1.Caption = "Opslaan in Verkooporders" 
            .OptionButton2.Caption = "Customer 1" 
            .OptionButton3.Caption = "Customer 1" 
            .OptionButton4.Caption = "Niet opslaan" 
            .OptionButton4.Value = True 
            .Show 
            If .Tag = 0 Then GoTo lbl_Exit 
            strName = oFrm.TextBox1.Text 
            Select Case True 
            Case Is = .OptionButton1.Value 
                objAtt.SaveAsFile saveFolder1 & strName 
            Case Is = .OptionButton2.Value 
                objAtt.SaveAsFile saveFolder2 & strName 
            Case Is = .OptionButton3.Value 
                objAtt.SaveAsFile saveFolder3 & strName 
            Case Else 
            End Select 
        End With 
        Unload oFrm 
    Next objAtt 
lbl_Exit: 
    Set oFrm = Nothing 
    Set objAtt = Nothing 
    Set olMsg = Nothing 
    Exit Sub 
End Sub

[Reptile209]

Kijk hier eens naar (scroll naar SetFileDateTime): http://www.cpearson.com/excel/FileTimes.htm
En ga anders eens verder met mijn search:
[google=outlook vba change file date]

[Verwijderd]

Bedankt Reptile209!

dit is inderdaad waar ik naar op zoek ben
Ik ben zelf alleen niet goed genoeg in VBA om dit ook in mijn code in te bouwen..
Kun jij dit wel? of is er iemand anders die dit kan?
het gaat er dus om dat de datum veranderd wordt naar het moment van opslaan

alvast bedankt!

[Reptile209]

Zoals de juf van mijn zoontje (groep 1) dan zegt: van proberen kan je leren .

Je hebt al een stuk code en het deel wat je wil toevoegen. Zoek nu de stukken waar de bijlagen worden opgeslagen (hint: het begint met Save). Daar vind je ook de folder en bestandsnaam terug. In het voorbeeld dat ik aanhaalde, wordt een datum gebruikt. In VBA krijg je de datum en tijd van dit moment met de functie Now() terug.

Combineer die kennis en dan ben je een heel eind! Bonuspunten als je het opslaan met de juiste datum dan ook nog in een aparte functie stopt, maar dat is geen noodzaak. Je kan het ook 3x herhalen voor je 3 opties.

En als je dan nog met een concrete vraag terugkomt, waarbij je laat zien dat je zelf al wat geprobeerd (en ge-googled) hebt, dan kunnen we je misschien weer verder op weg helpen!

Nog één tip: eerst je bestand opslaan en dan pas de datum aanpassen.

[ Voor 4% gewijzigd door Reptile209 op 03-05-2017 20:52 ]

[Verwijderd]

Ik kan zelf helemaal geen code schrijven, alleen aanpassen binnen een heel beperkt stukje van de taal.
wat dat betreft ook wel te vergelijken met een kind uit groep 1 (een heel klein deel snappen en zeker nog niets kunnen schrijven )

toch heb ik wat proberen te knutselen maar de code doet nog steeds exact hetzelfde als voor ik er mee aan de gang ben gegaan.
Hulp please!!

code:

Option Explicit

Public Enum FileDateToProcess
    FileDateCreate = 1
    FileDateLastAccess = 2
    FileDateLastModified = 3
End Enum

Public Function SetFileDateTime(FileName As String, _
        FileDateTime As Double, WhichDateToChange As FileDateToProcess, _
        Optional NoGMTConvert As Boolean = False) As Boolean
        
End Function

Public Sub saveAttachToDisk()
     
    Dim objAtt As Outlook.Attachment
    Dim olMsg As Outlook.MailItem
    Dim strName As String
    Dim lngAns As Long
    Dim oFrm As UserForm1
    Dim Result As Boolean
    Dim TheNewTime As Double
    Dim WhatTime As FileDateToProcess
    Dim TheNewDate As Double
    Const saveFolder1 As String = "C:\Temp\Test1\" 
    Const saveFolder2 As String = "C:\Temp\Test2\" 
    Const saveFolder3 As String = "C:\Temp\Test3\" 
     
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    For Each objAtt In olMsg.Attachments
            Set oFrm = New UserForm1
            With oFrm
                .Caption = "Select Save Option"
                .CommandButton1.Caption = "Doorgaan"
                .CommandButton2.Caption = "Opslaan afbreken"
                .TextBox1.Text = objAtt.FileName
                .OptionButton1.Caption = "Opslaan in Verkooporders"
                .OptionButton2.Caption = "Customer1"
                .OptionButton3.Caption = "Customer2"
                .OptionButton4.Caption = "Niet opslaan"
                .OptionButton4.Value = True
                .Show
                If .Tag = 0 Then GoTo lbl_Exit
                strName = oFrm.TextBox1.Text
                Select Case True
                Case Is = .OptionButton1.Value
                    objAtt.SaveAsFile saveFolder1 & strName
                    TheNewDate = Now()
                    Result = SetFileDateTime(FileName:=strName, FileDateTime:=TheNewDate, _
                         WhichDateToChange:=WhatTime, NoGMTConvert:=False)
                    If Result = True Then
                        Debug.Print "File date/time successfully modified."
                    Else
                        Debug.Print "An error occurred with SetFileDateTime."
                    End If
                Case Is = .OptionButton2.Value
                    objAtt.SaveAsFile saveFolder2 & strName
                    TheNewDate = Now()
                    Result = SetFileDateTime(FileName:=strName, FileDateTime:=TheNewDate, _
                         WhichDateToChange:=WhatTime, NoGMTConvert:=False)
                    If Result = True Then
                        Debug.Print "File date/time successfully modified."
                    Else
                        Debug.Print "An error occurred with SetFileDateTime."
                    End If
                Case Is = .OptionButton3.Value
                    objAtt.SaveAsFile saveFolder3 & strName
                    TheNewDate = Now()
                    Result = SetFileDateTime(FileName:=strName, FileDateTime:=TheNewDate, _
                         WhichDateToChange:=WhatTime, NoGMTConvert:=False)
                    If Result = True Then
                        Debug.Print "File date/time successfully modified."
                    Else
                        Debug.Print "An error occurred with SetFileDateTime."
                    End If
                Case Else
                End Select
                
            End With
            Unload oFrm
    Next objAtt
lbl_Exit:
    Set oFrm = Nothing
    Set objAtt = Nothing
    Set olMsg = Nothing
    Exit Sub
End Sub

[Reptile209]

Je bent al wel een heel eind zo te zien!

Ik zie in elk geval al twee dingen: bij het saven gebruik je saveFolder1 & strName, maar bij het veranderen van de datum gebruik je alleen strName. Met die eerste plak je bijvoorbeeld "c:\test\" en "bijlage.pdf" aan elkaar tot "c:\test\bestand.pdf". Anders kan je niet het juiste bestand vinden.
Tweede is dat WhatTime nog geen waarde heeft. Gebruik eens WhatTime = 1 (voor de Created datum).

En zet in VBA je Debug window aan (onder View geloof ik), daar komen de Debug.Print teksten terecht.

[Verwijderd]

ik heb gedaan wat je hierboven aangeeft en in het debug venster geeft hij inderdaad heel mooi aan dat het niet gelukt is.
ik heb achter WhatTime 1, 2 en 3 geprobeerd en met de voorgestelde caption zoals ik hem nu in onderstaande code heb. maar nog steeds niks

kan het iets te maken hebben met 'TheNewDate = Now()'?

code:

                Select Case True
                Case Is = .OptionButton1.Value
                    objAtt.SaveAsFile saveFolder1 & strName
                    TheNewDate = Now()
                    Result = SetFileDateTime(FileName:=saveFolder1 & strName, FileDateTime:=TheNewDate, _
                         WhichDateToChange:=WhatTime = FileDateCreate, NoGMTConvert:=False)
                    If Result = True Then
                        Debug.Print "File date/time successfully modified."
                    Else
                        Debug.Print "An error occurred with SetFileDateTime."
                    End If
                Case Is = .OptionButton2.Value
                    objAtt.SaveAsFile saveFolder2 & strName
                    TheNewDate = Now()
                    Result = SetFileDateTime(FileName:=saveFolder2 & strName, FileDateTime:=TheNewDate, _
                         WhichDateToChange:=WhatTime = FileDateLastAccess, NoGMTConvert:=False)
                    If Result = True Then
                        Debug.Print "File date/time successfully modified."
                    Else
                        Debug.Print "An error occurred with SetFileDateTime."
                    End If
                Case Is = .OptionButton3.Value
                    objAtt.SaveAsFile saveFolder3 & strName
                    TheNewDate = Now()
                    Result = SetFileDateTime(FileName:=saveFolder3 & strName, FileDateTime:=TheNewDate, _
                         WhichDateToChange:=WhatTime = FileDateLastModified, NoGMTConvert:=False)
                    If Result = True Then
                        Debug.Print "File date/time successfully modified."
                    Else
                        Debug.Print "An error occurred with SetFileDateTime."
                    End If
                Case Else
                End Select

[Niet Henk]

Je geeft geen correcte FileTime in de SetFileDateTime functie, maar een VBA datetime object. Deze moet eerst omgezet worden naar een FileTime voordat je hem kan gebruiken.
Dit is helaas niet heel makkelijk:
In een aparte VBA module kan je het volgende zetten (bron):

code:

Option Explicit
Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Private Declare Function SystemTimeToFileTime Lib "kernel32" ( _
    ByRef lpSystemTime As SYSTEMTIME, _
    ByRef lpFileTime As FILETIME) As Long


Public Function DateToFileTime(ByVal DateTime As Date) As FILETIME
    Dim stLocal As SYSTEMTIME
    Dim stUniversal As SYSTEMTIME
    Dim ftResult As FILETIME

    With stLocal
        .wYear = Year(DateTime)
        .wMonth = Month(DateTime)
        .wDay = Day(DateTime)
        .wHour = Hour(DateTime)
        .wMinute = Minute(DateTime)
        .wSecond = Second(DateTime)
    End With
    SystemTimeToFileTime stLocal, ftResult
    DateToFileTime = ftResult
End Function

En dan pas je in de macro alleen de volgende regel aan:

code:

   Result = SetFileDateTime(FileName:=saveFolder2 & strName, _ 
   FileDateTime:=DateToFileTime(TheNewDate), _
   WhichDateToChange:=WhatTime = FileDateLastAccess, NoGMTConvert:=False)

Noot: deze oplossing vereist aanpassing als hij gebruikt gaat worden in een 64-bits versie van Outlook

[ Voor 3% gewijzigd door Niet Henk op 05-05-2017 09:12 ]

[Verwijderd]

@Niet Henk ik heb jouw code erin gezet maar als ik de macro dan run krijg ik de volgende fout

"Compileerfout:
Typen komen niet met elkaar overeen"

DateToFileTime in het onderste stukje code wat je laat zien wordt dan gemarkeerd

[Niet Henk]

Excuus, foutje van mij. De vorige oplossing werkt niet goed in VBA, enkel in VB.
Probeer het volgende:

In de aparte module:

code:

Option Explicit
 
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type
 
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
 
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
 
Public Sub SetFileDate(ByVal sFileName As String, ByVal dDate As Date)

    Dim udtFileTime As FILETIME
    Dim udtLocalTime As FILETIME
    Dim udtSystemTime As SYSTEMTIME
    Dim lFileHandle As Long
    
    udtSystemTime.wYear = Year(dDate)
    udtSystemTime.wMonth = Month(dDate)
    udtSystemTime.wDay = Day(dDate)
    udtSystemTime.wDayOfWeek = Weekday(dDate) - 1
    udtSystemTime.wHour = Hour(dDate)
    udtSystemTime.wMinute = Minute(dDate)
    udtSystemTime.wSecond = Second(dDate)
    udtSystemTime.wMilliseconds = 0
    ' Convert system time to local time
    SystemTimeToFileTime udtSystemTime, udtLocalTime
    ' Convert local time to GMT
    LocalFileTimeToFileTime udtLocalTime, udtFileTime
    ' Open the file for writing to get the f
    '     ilehandle
    lFileHandle = CreateFile(sFileName, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
    ' If the file doesn't exist then tell the user
    If lFileHandle >= 0 Then
        ' Change date/time property of the file
        SetFileTime lFileHandle, udtFileTime, udtFileTime, udtFileTime
    Else
        MsgBox sFileName & " doesn't exist!", vbCritical, "Error"
    End If
    ' Close the file handle
    CloseHandle lFileHandle
End Sub

In jouw code:
Vervang dit stuk:

code:

                    Result = SetFileDateTime(FileName:=saveFolder2 & strName, FileDateTime:=TheNewDate, _
                         WhichDateToChange:=WhatTime = FileDateLastAccess, NoGMTConvert:=False)
                    If Result = True Then
                        Debug.Print "File date/time successfully modified."
                    Else
                        Debug.Print "An error occurred with SetFileDateTime."
                    End If

door dit:

code:

SetFileDate FileName, TheNewDate

Deze zet zowel de created als modified naar TheNewDate.

[Verwijderd]

nu krijg ik de compileerfout op FileName
wat denk ik ook wel logisch is omdat ik hem nergens definieer

of doe ik zelf iets fout?

[Niet Henk]

Oh, dat moet je bestandsnaam, saveFolder2 & strName zijn.

[Verwijderd]

Yes! nu werkt het

Bedankt!!