[Outlook 2010] VBA Script aanmaken folder - Client software algemeen

maandag 30 december 2013 13:13

Acties:

The offending line...

Topicstarter

Hallo,

Op mijn werk heb ik een script bedacht / geleend van het internet

om automatisch bijlages op te slaan die gescand / gemaild worden vanaf een multifunctional.
Deze werkt i.c.m. een x-aantal ingestelde regels prima.
De bijlages worden nu automatisch bij binnenkomst in de e-mail box opgeslagen in een daarvoor bestemde map als een .pdf bestand. B.v. 30-12-2013-13-05-22-naam van het onderwerp.
Zoals je kan zien worden de bijlages tot op de seconde nauwkeurig opgeslagen.
Nu wil ik graag in het script een toevoeging willen hebben dat de bijlages opgeslagen worden in een map met de datum vandaag. Dus als deze map nog niet bestaat, moet deze automatisch aangemaakt worden, en natuurlijk als deze al bestaat, dat er niks met de bestaande map gebeurt.

Is dit mogelijk in een VBA Script?

Mijn script zoals die nu hier draait (bepaalde zaken zoals pads eruit gelaten vanwege werk geheim e.d.)

code:

Sub CustomMailMessageRule(Msg As Outlook.MailItem)
Dim saveAttachment As Boolean
Dim myAttachments As Outlook.Attachments
Dim dispName As String
Dim dateFormat As String
dateFormat = Format(Now, "dd-mm-yyyy H-mm-ss")
Dim attPath As String
If (Msg.Subject = "Onderwerp van het document") And _
(Msg.Attachments.Count >= 1) Then
'location to save in.  Can be root drive or mapped network drive.
attPath = "\[i]Pad waar de bijlages worden opgeslagen\[/i]"
saveAttachment = True
End If
If (saveAttachment) Then
' save attachment
Set myAttachments = Msg.Attachments
dispName = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & dateFormat & " - " & dispName
' mark as read
Msg.UnRead = False
End If
End Sub

Mocht dit draadje niet in het juiste forum staan, dan alvast excuus.

Ik heb al verschillende dagen gezocht naar een oplossing, maar helaas nog niks concreets gevonden.

Alvast bedankt voor het meedenken.

donderdag 2 januari 2014 12:05

Acties:

LnC

The offending line...

Topicstarter

* LnC geeft een subtiel schopje

Iemand die weet of dit mogelijk is?

donderdag 2 januari 2014 12:21

Acties:

mhoogendam

Ik heb vroeger een script gemaakt om mails te archiveren op maand/jaar.
Ik gebruikte hiervoor onderstaande code (enkel relevante code getoond), misschien kan je er iets uit gebruiken.

VBScript:

Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Set objNS = Application.GetNamespace("MAPI")
strTimeStamp = Format(objItem.ReceivedTime, "mm-yy")
strTimeStampYear = Format(objItem.ReceivedTime, "yyyy")
Set objFolder = objNS.Folders("Personal Folders " & strTimeStampYear).Folders.Add("Inbox") 'Create folder "Inbox" if not exist.
Set objFolder = objNS.Folders("Personal Folders " & strTimeStampYear).Folders("Inbox").Folders.Add(strTimeStamp) 'Create folder "mm-yy" if not exist.
Set objFolder = objNS.Folders("Personal Folders " & strTimeStampYear).Folders("Inbox").Folders(strTimeStamp) 'Set folder to folder matching with timestamp

objItem.Move objFolder    'Move item to specified folder

donderdag 2 januari 2014 13:17

Acties:

Lustucru

26 03 2016

^^ gaat over MAPI folders en de TS bedoelt volgens mij filesystem folder.

VBA is wat beperkt met file-handling instructions maar dir en mkdir is hiervoor genoeg. WIl je meer, dan is het filesystem object aan te bevelen wat je ook in VBA kunt gebruiken.

Anyway, puur vba:

code:

1 2	folderToSaveAttachmentIn = "C:\test\" & Format(Date, "yyyyMMdd") If Dir(folderToSaveAttachmentIn, vbDirectory) = "" Then MkDir folderToSaveAttachmentIn

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland

donderdag 2 januari 2014 14:25

Acties:

mhoogendam

Lustucru schreef op donderdag 02 januari 2014 @ 13:17:
^^ gaat over MAPI folders en de TS bedoelt volgens mij filesystem folder.

Dat staat dan ook niet helemaal duidelijk in de tekst, ik zie nu dat het huidige script uitgaat van filesystem folders.

De bijlages worden nu automatisch bij binnenkomst in de e-mail box opgeslagen in een daarvoor bestemde map

Mijn script is inderdaad om mappen aan te maken in een Personal folder of de Mailbox zelf.

vrijdag 3 januari 2014 12:35

Acties:

LnC

The offending line...

Topicstarter

Lustucru schreef op donderdag 02 januari 2014 @ 13:17:
^^ gaat over MAPI folders en de TS bedoelt volgens mij filesystem folder.

VBA is wat beperkt met file-handling instructions maar dir en mkdir is hiervoor genoeg. WIl je meer, dan is het filesystem object aan te bevelen wat je ook in VBA kunt gebruiken.

Anyway, puur vba:
code:
1
2
folderToSaveAttachmentIn = "C:\test\" & Format(Date, "yyyyMMdd")
If Dir(folderToSaveAttachmentIn, vbDirectory) = "" Then MkDir folderToSaveAttachmentIn

Bedankt!
Ik ga hier eens verder mee stoeien. Je hebt mij in iedere geval meer opweg geholpen

vrijdag 3 januari 2014 13:18

Acties:

LnC

The offending line...

Topicstarter

De map wordt nu automatisch aangemaakt door het script (waarvoor dank). Alleen komt de bijlage die automatisch opgeslagen wordt nu niet automatisch in die map terecht.

Zo heb ik mijn script nu:

code:

Sub CustomMailMessageRule(Msg As Outlook.MailItem)
Dim saveAttachment As Boolean
Dim myAttachments As Outlook.Attachments
Dim dispName As String
Dim dateFormat As String
dateFormat = Format(Now, "dd-mm-yyyy H-mm-ss")
Dim attPath As String
If (Msg.Subject = "Naam van onderwerp") And _
(Msg.Attachments.Count >= 1) Then
'location to save in.  Can be root drive or mapped network drive.
attPath = "\\Pad waar de bijlages in opgeslagen worden\"
saveAttachment = True
folderToSaveAttachmentIn = "\\Pad waar de bijlages in opgeslagen worden\" & Format(Date, "dd-mm-yyyy")
If Dir(folderToSaveAttachmentIn, vbDirectory) = "" Then MkDir folderToSaveAttachmentIn
End If
If (saveAttachment) Then
' save attachment
Set myAttachments = Msg.Attachments
dispName = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & dateFormat & " - " & dispName
' mark as read
Msg.UnRead = False
End If
End Sub

Iemand een idee wat ik fout doe? Ik heb bij Filesystem object Microsoft Scripting Runtime aangezet (Dit had ik zo gelezen op een draadje op de site van Superuser. Moet deze qua Prioriteit omhoog bijvoorbeeld?

Alvast bedankt voor het meedenken. Ik ga zelf ook nog even verder speuren

vrijdag 3 januari 2014 13:43

Acties:

mhoogendam

Je code in regel 20 staat niet goed, die verwijst naar een verkeerde locatie.
attPath kan lijkt mij geheel weg. (regel7+11)

VBScript:

1	myAttachments.Item(1).SaveAsFile attPath & dateFormat & " - " & dispName

Moet zijn:

VBScript:

1	myAttachments.Item(1).SaveAsFile folderToSaveAttachmentIn & "\" & dispName

Heb de onnodige regels en code weggehaald:

VBScript:

Sub CustomMailMessageRule(Msg As Outlook.MailItem)
    Dim saveAttachment As Boolean
    Dim myAttachments As Outlook.Attachments
    Dim dispName As String
    Dim dateFormat As String
    dateFormat = Format(Now, "dd-mm-yyyy")
    
    If (Msg.Subject = "Naam van onderwerp") And (Msg.Attachments.Count >= 1) Then
        saveAttachment = True
        folderToSaveAttachmentIn = "\\Pad waar de bijlages in opgeslagen worden\" & dateFormat
        If Dir(folderToSaveAttachmentIn, vbDirectory) = "" Then 
            MkDir folderToSaveAttachmentIn
        End If
    End If
    If (saveAttachment) Then
        ' save attachment
        Set myAttachments = Msg.Attachments
        dispName = myAttachments.Item(1).DisplayName
        myAttachments.Item(1).SaveAsFile folderToSaveAttachmentIn & "\" & dispName      ' mark as read
        Msg.UnRead = False
    End If
End Sub

[ Voor 73% gewijzigd door mhoogendam op 03-01-2014 13:51 ]

vrijdag 3 januari 2014 14:05

Acties:

LnC

The offending line...

Topicstarter

Bedankt voor het meedenken.
Als ik deze code invoer in mijn script:

code:

1	myAttachments.Item(1).SaveAsFile folderToSaveAttachmentIn & "\" & dispName

dan slaat hij wel de bijlages op in de map met de datum van vandaag (wat ook mijn wens was). Alleen heeft de bijlage alleen de naam van het onderwerp, en niet zoals ik eerst had b.v. 03-01-2014-14-00-20.pdf

Ook zou ik de tijd (inclusief de seconden) als naam (zoals ik eerst had) van de bijlage blijven gebruiken.

Ik heb ook het script van mhoogendam gedraait. Die doet het prima, alleen ga ik ook nog even opzoek of het mogelijk is om mijn wensen erin te krijgen.

We blijven testen

vrijdag 3 januari 2014 14:34

Acties:

mhoogendam

Dan voegen we die weer toe

VBScript:

Sub CustomMailMessageRule(Msg As Outlook.MailItem)
    Dim saveAttachment As Boolean
    Dim myAttachments As Outlook.Attachments
    Dim dispName As String
    Dim FolderdateFormat As String
    Dim FiledateFormat As String
    FolderdateFormat = Format(Now, "dd-mm-yyyy")
    FiledateFormat = Format(Now, "dd-mm-yyyy H-mm-ss")
    If (Msg.Subject = "Naam van onderwerp") And (Msg.Attachments.Count >= 1) Then
        saveAttachment = True
        folderToSaveAttachmentIn = "\\Pad waar de bijlages in opgeslagen worden\" & FolderdateFormat 
        If Dir(folderToSaveAttachmentIn, vbDirectory) = "" Then 
            MkDir folderToSaveAttachmentIn
        End If
    End If
    If (saveAttachment) Then
        ' save attachment
        Set myAttachments = Msg.Attachments
        dispName = myAttachments.Item(1).DisplayName
        myAttachments.Item(1).SaveAsFile folderToSaveAttachmentIn & "\" & FiledateFormat & " - " & dispName
        ' mark as read
        Msg.UnRead = False
    End If
End Sub

vrijdag 3 januari 2014 14:40

Acties:

LnC

The offending line...

Topicstarter

Geweldig! Het werkt!

Kudos en pluspunten, airmiles en andere punten naar mhoogendam, Lustucru.
Bedankt! $_/-\o_$

Pagina: 1

Reageer