Solved

VbScript in Outlok - saving file af .msg and attaching it to my filesoftware (Amicus Attorney)

Posted on 2006-06-20
3
596 Views
Last Modified: 2008-01-09
I a user of a program called Amicus Attorney. It has the capability to a link to files. Basically its a database. In word there is a macro, that makes it possible to attach the document to the program. Now I want to do the same wil e-mails.

With inspiration from another question on EE I have developed the script below. It consists of two parts. First it saves the mail as a .msg file (that part works fine) secondly it should attach the file to Amicus Attorney. The second part is taken out from the word script and it works there, however in Outlook it keeps on giving me errors saying "variable not defined". Please help.


Option Explicit

Const sIniFile = "aa50.ini"
Const sAAExe = "aa50.exe"

Sub SaveFile()
    Dim theSel As Outlook.Selection, _
        itm As MailItem, _
        itmAttachment As Attachment, _
        strFilename As String
        Const strFolder = "C:\temp\"
        Dim i As Integer
       
    Set theSel = Application.ActiveExplorer.Selection
    If theSel.Count = 0 Then
        Exit Sub
    ElseIf theSel.Count = 1 Then
            Do
                i = i + 1
                strFilename = "Mail" & " " & Format$(i, "0000000") & ".msg"
            Loop Until Dir$(strFolder & strFilename) = ""
           
            itm.SaveAs strFolder & strFilename, olMSG
           
            'This is not needed for now
            'If itm.Attachments.Count > 0 Then
            '    For Each itmAttachment In itm.Attachments
            '        itmAttachment.SaveAsFile "C:\eeTesting\Saves\" & itmAttachment.FileName
            '    Next
            'End If
           
        Set Item = Nothing
        Set theSel = Nothing
    End If

'Second part saving in Amicus Attorney

            System.PrivateProfileString(sIniFile, "Add Doc To File Brad", "ShortFileName") = ""
            System.PrivateProfileString(sIniFile, "Add Doc To File Brad", "File") = strFolder & strFilename
            System.PrivateProfileString(sIniFile, "Add Doc To File Brad", "DocTitle") = "" 'sCaptionOut
       
            If Tasks.Exists("Amicus Attorney") = True Then
                    Tasks("Amicus Attorney").Activate
                    Tasks("Amicus Attorney").SendWindowMessage 1024 + 515, 0, 0
            Else
                Dim sAmicusPath As String
                Dim lRetValue As Long
               
                'we should make sure that short file name is set to null to allow selection of files to attach doc to brad
                System.PrivateProfileString(sIniFile, "Add Doc To File Brad", "ShortFileName") = ""
                System.PrivateProfileString(sIniFile, "Third-party-application", "ProcessSaveToBrad") = "1"
               
                sAmicusPath = System.PrivateProfileString(sIniFile, "PATHS", "LocalAmicusPath")
                sAmicusPath = sAmicusPath + sAAExe
               
                lRetValue = Shell(sAmicusPath, vbNormalFocus)
            End If

   
End Sub
0
Comment
Question by:Zoodiaq
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 

Author Comment

by:Zoodiaq
ID: 16944336
Ok I seemed to have solved most of the problem. I added a reference to word form VB in Outlook. However it seems, that I need to have a word session open to use the script. Is there anyway to avoid it or maybe to have the script to open a word session if it is not opened.
0
 

Author Comment

by:Zoodiaq
ID: 16944579
I solved the problem with word also, sorry guys I'm getting better at this every day ;-)

Heres my final script:

Option Explicit

Const sIniFile = "aa50.ini"
Const sAAExe = "aa50.exe"

Sub SaveFile()
    Dim theSel As Outlook.Selection, _
        itm As MailItem, _
        itmAttachment As Attachment, _
        strFilename As String
        Const strFolder = "C:\temp\"
        Dim i As Integer
    Dim wd As Word.Application 'for testing
   
    On Error GoTo bye
   
    Set wd = New Word.Application ' create the Word application object

    wd.System.PrivateProfileString("aa50.ini", "Add Doc To File Brad", "ShortFileName") = "" 
   
    'System.PrivateProfileString("aa50.ini", "Add Doc To File Brad", "ShortFileName") = ""
   
    Set theSel = Application.ActiveExplorer.Selection
    If theSel.Count = 0 Then
        Exit Sub
    ElseIf theSel.Count > 1 Then
    MsgBox "Der må kun vælges én mail ad gangen"
    Exit Sub
    Else
     
        For Each itm In theSel

            Do
                i = i + 1
                strFilename = "Mail" & " " & Format$(i, "0000000") & ".msg"
            Loop Until Dir$(strFolder & strFilename) = ""
           
            itm.SaveAs strFolder & strFilename, olMSG
           
            itm.Delete
        Next
           
            Set itm = Nothing
            Set theSel = Nothing
       
    End If

'Second part saving in Amicus Attorney

            wd.System.PrivateProfileString("aa50.ini", "Add Doc To File Brad", "ShortFileName") = ""
            wd.System.PrivateProfileString(sIniFile, "Add Doc To File Brad", "File") = strFolder & strFilename
            wd.System.PrivateProfileString(sIniFile, "Add Doc To File Brad", "DocTitle") = "" 'sCaptionOut
                    If wd.Tasks.Exists("Amicus Attorney") = True Then
                    wd.Tasks("Amicus Attorney").Activate
                    wd.Tasks("Amicus Attorney").SendWindowMessage 1024 + 515, 0, 0
            Else
                Dim sAmicusPath As String
                Dim lRetValue As Long
           
                'we should make sure that short file name is set to null to allow selection of files to attach doc to brad
                wd.System.PrivateProfileString(sIniFile, "Add Doc To File Brad", "ShortFileName") = ""
                wd.System.PrivateProfileString(sIniFile, "Third-party-application", "ProcessSaveToBrad") = "1"
           
                sAmicusPath = wd.System.PrivateProfileString(sIniFile, "PATHS", "LocalAmicusPath")
                sAmicusPath = sAmicusPath + sAAExe
           
                lRetValue = Shell(sAmicusPath, vbNormalFocus)
            End If
           
            Set wd = Nothing ' destroy the Word application object 'for testing
           

Exit Sub

bye:

End Sub
0
 

Accepted Solution

by:
EE_AutoDeleter earned 0 total points
ID: 17093349
Zoodiaq,
Because you have presented a solution to your own problem which may be helpful to future searches, this question is now PAQed and your points have been refunded.

EE_AutoDeleter
0

Featured Post

Visualize your virtual and backup environments

Create well-organized and polished visualizations of your virtual and backup environments when planning VMware vSphere, Microsoft Hyper-V or Veeam deployments. It helps you to gain better visibility and valuable business insights.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Are you unable to connect or configure Hotmail email account in Microsoft Outlook 2010, 2007? Or Outlook.com emails are not downloading to Outlook? Lets’ see the problem and resolve Outlook Connector error syncing folder hierarchy (0x8004102A).
This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…

749 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question