Macro needed

Our Sales department send out quite a lot of emails with a price list attached. We have separate price lists for each of our product ranges, and each of the price lists is available in several currencies.

To save a bit of time, it would be nice to have a macro attached to a keyboard shortcut which opens the Insert Attachment dialog and displays the folder where the price lists are stored. For instance, I have set up a P: drive where all the price lists are stored. So it would be great if the user could press Ctrl->P and the Insert Attachment dialog would pop up and show the contents of the P: drive so that the user could choose the appropriate price list.
TownTalkAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

KimputerCommented:
Strangely Outlook VBA doesn't have this dialog programmed for you (like Excel does already), so you need to add a Class Module:

Private Declare Function GetOpenFileName Lib _
   "comdlg32.dll" Alias "GetOpenFileNameA" _
   (pOFStruct As OFStruct) As Long

 Private Type OFStruct
   lStructSize As Long
   hwndOwner As Long
   hInstance As Long
   lpstrFilter As String
   lpstrCustomFilter As String
   nMaxCustFilter As Long
   nFilterIndex As Long
   lpstrFile As String
   nMaxFile As Long
   lpstrFileTitle As String
   nMaxFileTitle As Long
   lpstrInitialDir As String
   lpstrTitle As String
   flags As Long
   nFileOffset As Integer
   nFileExtension As Integer
   lpstrDefExt As String
   lCustData As Long
   lpfnHook As Long
   lpTemplateName As String
 End Type

 Private pstrFileName As String
 Private pstrFileTitle As String
 Private pstrInitDir As String
 Private pstrFilter As String
 Private pintFilterIndex As Integer
 Private pstrDialogTitle As String
 Private plngFlags As Long

 Public Property Let FileName(strName As String)
   pstrFileName = strName
 End Property

 Public Property Get FileName() As String
   FileName = pstrFileName
 End Property

 Public Property Get FileTitle() As String
   FileTitle = pstrFileTitle
 End Property

 Public Property Let InitDir(strName As String)
   pstrInitDir = strName
 End Property

 Public Property Get InitDir() As String
   InitDir = pstrInitDir
 End Property

 Public Property Let Filter(strName As String)
   pstrFilter = strName
 End Property

 Public Property Get Filter() As String
   Filter = pstrFilter
 End Property

 Public Property Get FilterIndex() As Integer
   FilterIndex = pintFilterIndex
 End Property

 Public Property Let FilterIndex(intNum As Integer)
   pintFilterIndex = intNum
 End Property

 Public Property Let DialogTitle(strName As String)
   pstrDialogTitle = strName
 End Property

 Public Property Get DialogTitle() As String
   DialogTitle = pstrDialogTitle
 End Property

 Public Property Let flags(lngNum As Long)
   plngFlags = lngNum
 End Property

 Public Property Get flags() As Long
   flags = plngFlags
 End Property

 Public Function OpenDialog() As Boolean
   Dim OpenFile As OFStruct
   Dim lngRet As Long

   With OpenFile
     .lStructSize = Len(OpenFile)
     .lpstrFilter = Replace(pstrFilter, "|", vbNullChar) & vbNullChar
     .nFilterIndex = pintFilterIndex
     .lpstrFile = pstrFileName & String$(512 - Len(pstrFileName), 0)
     .nMaxFile = Len(.lpstrFile) - 1
     .lpstrFileTitle = String$(.nMaxFile, 0)
     .nMaxFileTitle = .nMaxFile
     .lpstrInitialDir = pstrInitDir
     .lpstrTitle = pstrDialogTitle
     .flags = plngFlags
   End With
   
   lngRet = GetOpenFileName(OpenFile)
   If lngRet = 0 Then
     pstrFileName = ""
     pstrFileTitle = ""
   Else
     pstrFileName = Left$(OpenFile.lpstrFile, InStr(OpenFile.lpstrFile, vbNullChar) - 1)
     pstrFileTitle = Left$(OpenFile.lpstrFileTitle, InStr(OpenFile.lpstrFileTitle, vbNullChar) - 1)
   End If
   OpenDialog = lngRet
 End Function

 

Private Sub Class_Initialize()

End Sub

Open in new window



Then add a module:

Public Sub AddAttachment()

    Dim cls As New Class1
     Dim strFile As String

     On Error GoTo ErrHandler

     If TypeName(ActiveWindow) = "Inspector" Then
         If Not ActiveInspector.CurrentItem.Class = olMail Then
             MsgBox "This item is not an e-mail message.", vbExclamation
         Else
             cls.Filter = "All files|*.*"
             cls.InitDir = "P:\"
             If cls.OpenDialog Then
                 strFile = cls.FileName
                 ActiveInspector.CurrentItem.Attachments.Add strFile
             End If
         End If
     ElseIf TypeName(ActiveWindow) = "Explorer" Then
         MsgBox "Please open an e-mail message and try again.", vbInformation
     End If

ExitHandler:
     Set cls = Nothing
     Exit Sub

ErrHandler:
     MsgBox Err.Description, vbExclamation
     Resume ExitHandler
 End Sub

 

Open in new window


Please note, there's a mentioning of "Dim cls As New Class1", this Class1 is the name of the Class Module you added. In case there were already more, the name is probably Classxx (where xx is a higher number), change the line of code accordingly.

After you tested it works, assign a button to this macro (as there are not hot key assignments in Outlook).
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
TownTalkAuthor Commented:
That's great. Thanks for your help :)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.