none
VBA Datepicker for Outlook Macro?? RRS feed

  • Question

  • Hi,

    I'm new to VBA. I've been running into some problems and came here to seek help from the more experienced users.

    I'm currently trying to create an Outlook macro.

    The goal of the macro is to save picture attachments of opened email to a designated folder, but I want the user to input a date (translated to MMDDYYYY format) using a datepicker which will be then added to the front of the filename when it gets saved.

    My current macro saves attachments to a designated folder, but I've been having problems with the datepicker. I've been desperately looking for a datepicker control for VBA but had no luck so far after 2days of researching. I'm working with Outlook 2007, and I even tried adding mscomct2.ocx but that resulted in an error.

    Any tips?

    Wednesday, June 13, 2012 4:45 PM

Answers

  • If you want to apply different dates to each attachment and only save image attachments then you will have to define the image file types and loop the userform for each attachment. Add a cancel button to the userform (so you can skip an image) and a label (here Label1) so that you can display which image you are saving. Then change your Outlook module code as follows.

    Option Explicit
    Sub SaveAttachment()
    Dim MyOlNameSpace As NameSpace
    Dim MySelectedItem As MailItem
    Dim objAttachment As Attachment
    Dim vFileType As Variant
    Dim MyFile As String
    Dim i As Long
    Const FolderPath As String = "C:\designatedfolder\save"
    Set MyOlNameSpace = GetNamespace("MAPI")
    vFileType = Split("tif|jpg|bmp|png|gif", "|") 'file types to process are 3 lower case characters separated by '|'

    For Each MySelectedItem In ActiveExplorer.Selection
        For Each objAttachment In MySelectedItem.Attachments
            For i = 0 To UBound(vFileType)
                If Right(LCase(objAttachment.FileName), 3) = vFileType(i) Then
                    With frmScreenSaver
                        .Label1.Caption = "Select date for" & vbCr & objAttachment.FileName
                        .DTPicker1.SetFocus
                        .Show
                        If .Tag = 1 Then
                            MyFile = objAttachment.FileName
                            MyFile = Format(.DTPicker1.Value, "yyyyMMdd") & "_" & MyFile
                            objAttachment.SaveAsFile (FolderPath & "\" & MyFile)
                        End If
                    End With
                    Unload frmScreenSaver
                End If
            Next i
        Next objAttachment
    Next MySelectedItem

    'Cleanup
    Set objAttachment = Nothing
    Set MyOlNameSpace = Nothing
    Set MySelectedItem = Nothing

    End Sub

    The code for the userform is then

    Option Explicit

    Private Sub cmdSave_Click()
    With Me
        .Tag = 1
        .Hide
    End With
    End Sub

    Private Sub cmdCancel_Click()
    With Me
        .Tag = 0
        .Hide
    End With
    End Sub


    'blocks the closing of the form by clicking the X and thus preventing an error
    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then
        Cancel = True
    End If
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com



    • Edited by Graham MayorMVP Saturday, June 16, 2012 6:56 AM
    • Marked as answer by tpmind Monday, June 18, 2012 10:36 PM
    Saturday, June 16, 2012 6:53 AM

All replies

  • Hi Tpmind,

    Welcome to the MSDN forum.

    This is a VB.Net forum and not suitable for VBA issue. I will move this thread to VBA forum.

    Sorry for any incontinences and have a nice day.


    Mark Liu-lxf [MSFT]
    MSDN Community Support | Feedback to us

    Thursday, June 14, 2012 5:16 AM
    Moderator
  • I do not know where you have problem.

    Take look on this:

    Dim a$
    If Month(Now) < 10 Then a = "0"
    Me.DTPicker1.value = Year(Now) & "-" & a & Month(Now) & "-01"
    'or strait like this
    'Me.DTPicker1.value = Now
    After you'll chose, assign this date to variable and add to new file name

    Oskar Shon, Office System MVP

    Press if Helpful; Answer when a problem solved

    Thursday, June 14, 2012 9:27 AM
    Answerer
  • My guess is that you are using the Windows 7 64bit OS which has a few minor issues with mscomct2.ocx. My web page http://www.gmayor.com/popup_calendar.htm explains how to overcome them.

    Graham Mayor - Word MVP
    www.gmayor.com

    Thursday, June 14, 2012 1:21 PM
  • My guess is that you are using the Windows 7 64bit OS which has a few minor issues with mscomct2.ocx. My web page http://www.gmayor.com/popup_calendar.htm explains how to overcome them.

    Graham Mayor - Word MVP
    www.gmayor.com

    Hi Graham,

    Yes, I’m on Windows 7 64bit OS. I was, however, able to figure out installing the mscomct2.ocx ActiveX yesterday and got to play around with the DatePicker control a little bit.

    Now I’m trying to figure out how to combine the code that I have in the module (saving attachments) with the form with the datepicker control.

    Here’s my plan…

    After making sure there’s at least one attachment, I want to prompt the user with the datepicker. Then I’ll pass on the selected date in MMDDYYYY format and add it to the beginning of the filename and save it to a designated folder. I also want separate datepickers for multiple attachments (I do not know how to approach this yet).

    I’ll go ahead and take a look at your web page for reference. Meanwhile, any other tips will be greatly appreciated.

     

    Thanks so much,

    tpmind


    Thursday, June 14, 2012 4:10 PM
  • I do not know where you have problem.

    Take look on this:

    Dim a$
    If Month(Now) < 10 Then a = "0"
    Me.DTPicker1.value = Year(Now) & "-" & a & Month(Now) & "-01"
    'or strait like this
    'Me.DTPicker1.value = Now
    After you'll chose, assign this date to variable and add to new file name

    Oskar Shon, Office System MVP

    Press if Helpful; Answer when a problem solved

    Hi Oskar,

    The issue was that I could not install the datepicker control, which is now fixed.

    Now I'm trying to figure out how to pass the user input into the format I want (MMDDYYYY). I'll check your example out.

    I'm reading VBA tutorials and how-to's since I'm new at this. Hopefully I'll pick up the pace soon.

    Thanks,

    tpmind

    Thursday, June 14, 2012 4:14 PM
  • The result of the date picker is DTPicker1.Value so  Format(DTPicker1.Value, "MMddyyyy") will give you the format you want. Call the userform from your Outlook macro and assuming the filename you already have is strFilename add the date to that e.g.

    With frmUserformName

    .Show

    strFilename = Format(.DTPicker1.Value, "MMddyyyy") & strFilename

    End With

    Unload frmUserformName

    now save the item with the name strfilename

    It occurs to me that you may not need to prompt for a date. The following will save selected messages with the received date included in the filename and is what I use myself to save messages:

    Sub SaveSelectedMessages()
    Dim olItem As Outlook.MailItem
    Dim fName As String
    Dim fPath As String
    fPath = "C:\Users\<UserName>\Documents\<subfoldername>\"
    For Each olItem In ActiveExplorer.Selection
        fName = Format(olItem.ReceivedTime, "yyyymmdd") & Chr(32) & _
        Format(olItem.ReceivedTime, "HH.MM") & Chr(32) & olItem.SenderName & " - " & olItem.Subject & ".msg"
        fName = Replace(fName, Chr(58) & Chr(41), "")
        fName = Replace(fName, Chr(58) & Chr(40), "")
        fName = Replace(fName, Chr(34), "-")
        fName = Replace(fName, Chr(42), "-")
        fName = Replace(fName, Chr(47), "-")
        fName = Replace(fName, Chr(58), "-")
        fName = Replace(fName, Chr(60), "-")
        fName = Replace(fName, Chr(62), "-")
        fName = Replace(fName, Chr(63), "-")
        fName = Replace(fName, Chr(124), "-")
        olItem.SaveAs fPath & fName
    Next olItem
    Set olItem = Nothing
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com




    Friday, June 15, 2012 4:35 AM
  • The result of the date picker is DTPicker1.Value so  Format(DTPicker1.Value, "MMddyyyy") will give you the format you want. Call the userform from your Outlook macro and assuming the filename you already have is strFilename add the date to that e.g.

    With frmUserformName

    .Show

    strFilename = Format(.DTPicker1.Value, "MMddyyyy") & strFilename

    End With

    Unload frmUserformName

    now save the item with the name strfilename

    It occurs to me that you may not need to prompt for a date. The following will save selected messages with the received date included in the filename and is what I use myself to save messages:

    Sub SaveSelectedMessages()
    Dim olItem As Outlook.MailItem
    Dim fName As String
    Dim fPath As String
    fPath = "C:\Users\<UserName>\Documents\<subfoldername>\"
    For Each olItem In ActiveExplorer.Selection
        fName = Format(olItem.ReceivedTime, "yyyymmdd") & Chr(32) & _
        Format(olItem.ReceivedTime, "HH.MM") & Chr(32) & olItem.SenderName & " - " & olItem.Subject & ".msg"
        fName = Replace(fName, Chr(58) & Chr(41), "")
        fName = Replace(fName, Chr(58) & Chr(40), "")
        fName = Replace(fName, Chr(34), "-")
        fName = Replace(fName, Chr(42), "-")
        fName = Replace(fName, Chr(47), "-")
        fName = Replace(fName, Chr(58), "-")
        fName = Replace(fName, Chr(60), "-")
        fName = Replace(fName, Chr(62), "-")
        fName = Replace(fName, Chr(63), "-")
        fName = Replace(fName, Chr(124), "-")
        olItem.SaveAs fPath & fName
    Next olItem
    Set olItem = Nothing
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com




    Hi Graham,

    Thanks for your help! Here's what I have in my project right now.

    Starting with the module...

    Private Const BIF_RETURNONLYFSDIRS As Long = &H1
    Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
    Private Const BIF_RETURNFSANCESTORS As Long = &H8
    Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
    Private Const BIF_BROWSEFORPRINTER As Long = &H2000
    Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
    Private Const MAX_PATH As Long = 260
    
    Sub runFrm()
     'Get all selected items
        Set MyOlApplication = CreateObject("Outlook.Application")
        Set MyOlNameSpace = MyOlApplication.GetNamespace("MAPI")
        Set MyOlSelection = MyOlApplication.ActiveExplorer.Selection
    
        'Make sure at least one item is selected
        If MyOlSelection.Count = 0 Then
           Response = MsgBox("Please select an e-mail", vbExclamation, MyApplName)
           Exit Sub
        End If
        
        'Make sure only one item is selected
        If MyOlSelection.Count > 1 Then
           Response = MsgBox("Please select only one e-mail", vbExclamation, MyApplName)
           Exit Sub
        End If
        
        'Retrieve the selected item
        Set MySelectedItem = MyOlSelection.Item(1)
         
        'Retrieve all attachments from the selected item
        Dim colAttachments As Outlook.Attachments
        Dim objAttachment As Outlook.Attachment
        Set colAttachments = MySelectedItem.Attachments
    
        If colAttachments.Count = 0 Then
            Response = MsgBox("There are no attachments to save!", vbExclamation, MyApplName)
            Exit Sub
        End If
    
        frmScreenSaver.Show
    End Sub
    
    Sub SaveAttachment(endDate As String)
        'Get all selected items
        Set MyOlApplication = CreateObject("Outlook.Application")
        Set MyOlNameSpace = MyOlApplication.GetNamespace("MAPI")
        Set MyOlSelection = MyOlApplication.ActiveExplorer.Selection
        
        'Retrieve the selected item
        Set MySelectedItem = MyOlSelection.Item(1)
         
        'Retrieve all attachments from the selected item
        Dim colAttachments As Outlook.Attachments
        Dim objAttachment As Outlook.Attachment
        Set colAttachments = MySelectedItem.Attachments
        
        'Save attachments to designated folder
        Dim FolderPath As String
        FolderPath = "C:\designatedfolder\save"
        
        'Save all attachments to the selected location with the date user selected in front of the file name
        'Dim DateStamp As String
        Dim MyFile As String
        For Each objAttachment In colAttachments
            MyFile = objAttachment.FileName
            MyFile = endDate & "_" & MyFile
            objAttachment.SaveAsFile (FolderPath & "\" & MyFile)
        Next
        
        Unload frmScreenSaver
        
        'Cleanup
        Set objAttachment = Nothing
        Set colAttachments = Nothing
        Set MyOlApplication = Nothing
        Set MyOlNameSpace = Nothing
        Set MyOlSelection = Nothing
        Set MySelectedItem = Nothing
    
    End Sub
    

    and here's my form module

    Private Sub cmdSave_Click()
        Dim endDate As String
        endDate = Format(DTPicker1.Value, "yyyyMMdd")
        'MsgBox (Date)
        SaveAttachment (endDate)
    End Sub

    I'm not sure how efficient the passing of variables are currently (going from standard module to form to back to standard module), but it seems to do the trick. Some parts of the code are repeated in the standard module, and I'm wondering if there's a better way to handle this.

    The macro above works right now to save attachments (if there are any) to the designated folder with the appropriate datestamp. However, I need to find a way to handle multiple attachments in the case that the user wants to select different dates for each attachments. I also want to save picture files only (.jpeg, .png, .gif, etc...) and don't know how to do this. 

    Can you give some tips regarding how I can handle separate datepickers for multiple attachments and only saving picture files? If there's a better way to piece the standard module and user form module, please let me know.

    Thanks!

    tpmind



    • Edited by tpmind Friday, June 15, 2012 10:19 PM
    Friday, June 15, 2012 6:42 PM
  • If you want to apply different dates to each attachment and only save image attachments then you will have to define the image file types and loop the userform for each attachment. Add a cancel button to the userform (so you can skip an image) and a label (here Label1) so that you can display which image you are saving. Then change your Outlook module code as follows.

    Option Explicit
    Sub SaveAttachment()
    Dim MyOlNameSpace As NameSpace
    Dim MySelectedItem As MailItem
    Dim objAttachment As Attachment
    Dim vFileType As Variant
    Dim MyFile As String
    Dim i As Long
    Const FolderPath As String = "C:\designatedfolder\save"
    Set MyOlNameSpace = GetNamespace("MAPI")
    vFileType = Split("tif|jpg|bmp|png|gif", "|") 'file types to process are 3 lower case characters separated by '|'

    For Each MySelectedItem In ActiveExplorer.Selection
        For Each objAttachment In MySelectedItem.Attachments
            For i = 0 To UBound(vFileType)
                If Right(LCase(objAttachment.FileName), 3) = vFileType(i) Then
                    With frmScreenSaver
                        .Label1.Caption = "Select date for" & vbCr & objAttachment.FileName
                        .DTPicker1.SetFocus
                        .Show
                        If .Tag = 1 Then
                            MyFile = objAttachment.FileName
                            MyFile = Format(.DTPicker1.Value, "yyyyMMdd") & "_" & MyFile
                            objAttachment.SaveAsFile (FolderPath & "\" & MyFile)
                        End If
                    End With
                    Unload frmScreenSaver
                End If
            Next i
        Next objAttachment
    Next MySelectedItem

    'Cleanup
    Set objAttachment = Nothing
    Set MyOlNameSpace = Nothing
    Set MySelectedItem = Nothing

    End Sub

    The code for the userform is then

    Option Explicit

    Private Sub cmdSave_Click()
    With Me
        .Tag = 1
        .Hide
    End With
    End Sub

    Private Sub cmdCancel_Click()
    With Me
        .Tag = 0
        .Hide
    End With
    End Sub


    'blocks the closing of the form by clicking the X and thus preventing an error
    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then
        Cancel = True
    End If
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com



    • Edited by Graham MayorMVP Saturday, June 16, 2012 6:56 AM
    • Marked as answer by tpmind Monday, June 18, 2012 10:36 PM
    Saturday, June 16, 2012 6:53 AM
  • Thanks so much Graham!

    With your help, I tweaked what I had and now it works! Really appreciate the help :)

    Monday, June 18, 2012 10:35 PM
  • Graham,

    You're doing a great job in the forums. Could you please email me? It's edprice at Microsoft.

    Thanks!


    Ed Price (a.k.a User Ed), SQL Server Experience Program Manager (Blog, Twitter, Wiki)

    Wednesday, July 18, 2012 12:23 AM
  • tpmind take look on this: Lekcja 3. Export załączników z parametrami | 2010-12-16 10:18:00

    Interfejs programu

    or this solution: Przeliczenie wiadomości z załącznikami | 2010-11-10 14:39:00

    It's free to add and modyf.

    Regards.


    Oskar Shon, Office System MVP

    Press if Helpful; Answer when a problem solved

    Wednesday, July 18, 2012 8:44 PM
    Answerer