Link to home
Start Free TrialLog in
Avatar of Zoodiaq
Zoodiaq

asked on

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

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
Avatar of Zoodiaq
Zoodiaq

ASKER

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.
Avatar of Zoodiaq

ASKER

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
ASKER CERTIFIED SOLUTION
Avatar of EE_AutoDeleter
EE_AutoDeleter

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial