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.PrivateProfileStrin g(sIniFile , "Add Doc To File Brad", "ShortFileName") = ""
System.PrivateProfileStrin g(sIniFile , "Add Doc To File Brad", "File") = strFolder & strFilename
System.PrivateProfileStrin g(sIniFile , "Add Doc To File Brad", "DocTitle") = "" 'sCaptionOut
If Tasks.Exists("Amicus Attorney") = True Then
Tasks("Amicus Attorney").Activate
Tasks("Amicus Attorney").SendWindowMessa ge 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.PrivateProfileStrin g(sIniFile , "Add Doc To File Brad", "ShortFileName") = ""
System.PrivateProfileStrin g(sIniFile , "Third-party-application", "ProcessSaveToBrad") = "1"
sAmicusPath = System.PrivateProfileStrin g(sIniFile , "PATHS", "LocalAmicusPath")
sAmicusPath = sAmicusPath + sAAExe
lRetValue = Shell(sAmicusPath, vbNormalFocus)
End If
End Sub
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
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.PrivateProfileStrin
System.PrivateProfileStrin
System.PrivateProfileStrin
If Tasks.Exists("Amicus Attorney") = True Then
Tasks("Amicus Attorney").Activate
Tasks("Amicus Attorney").SendWindowMessa
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.PrivateProfileStrin
System.PrivateProfileStrin
sAmicusPath = System.PrivateProfileStrin
sAmicusPath = sAmicusPath + sAAExe
lRetValue = Shell(sAmicusPath, vbNormalFocus)
End If
End Sub
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.PrivateProfileSt ring("aa50 .ini", "Add Doc To File Brad", "ShortFileName") = ""
'System.PrivateProfileStri ng("aa50.i ni", "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.PrivateProfileSt ring("aa50 .ini", "Add Doc To File Brad", "ShortFileName") = ""
wd.System.PrivateProfileSt ring(sIniF ile, "Add Doc To File Brad", "File") = strFolder & strFilename
wd.System.PrivateProfileSt ring(sIniF ile, "Add Doc To File Brad", "DocTitle") = "" 'sCaptionOut
If wd.Tasks.Exists("Amicus Attorney") = True Then
wd.Tasks("Amicus Attorney").Activate
wd.Tasks("Amicus Attorney").SendWindowMessa ge 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.PrivateProfileSt ring(sIniF ile, "Add Doc To File Brad", "ShortFileName") = ""
wd.System.PrivateProfileSt ring(sIniF ile, "Third-party-application", "ProcessSaveToBrad") = "1"
sAmicusPath = wd.System.PrivateProfileSt ring(sIniF ile, "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
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.PrivateProfileSt
'System.PrivateProfileStri
Set theSel = Application.ActiveExplorer
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.PrivateProfileSt
wd.System.PrivateProfileSt
wd.System.PrivateProfileSt
If wd.Tasks.Exists("Amicus Attorney") = True Then
wd.Tasks("Amicus Attorney").Activate
wd.Tasks("Amicus Attorney").SendWindowMessa
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.PrivateProfileSt
wd.System.PrivateProfileSt
sAmicusPath = wd.System.PrivateProfileSt
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER