H
hlock
Using code from Word, we want to customize it for Outlook 2007. The goal of
the code is to save an email as a .txt file and prepare it for importing to
our document repository. Not familiar with programming, we have tried to
work with the code below. Now, it keeps getting stuck at message.save as
part. Any suggestions?
Sub SaveToIDM_Claim()
Dim fso
Dim Fil
Dim ns As Outlook.NameSpace
Dim message As MailItem
Dim ext As String
Dim filename As String
Dim tempfile As String
Dim tempdir As String
Dim path As String
Dim del As String ' import delete parameter
Dim app As String 'import application parameter
' Set fso = New FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set ns = GetNamespace("MAPI")
' Change AppName to an import parameter...
app = "/a=clmdoc"
' Save a copy of the email to a file of the same name
' but in the system's temporary directory...
tempdir = fso.GetSpecialFolder(2)
filename = "importemail"
' If an email has not yet been saved, it does not have an extension
' So add an .txt extension...
If fso.GetExtensionName(filename) = "" Then
filename = filename & ".txt"
End If
' Save the extension...
ext = fso.GetExtensionName(filename)
path = fso.BuildPath(tempdir, filename)
' If a file with than name already exists,
' start generating random file names until one does not exist...
Do While fso.FileExists(path)
tempfile = fso.GetTempName
tempfile = fso.GetBaseName(tempfile) & "." & ext
path = fso.BuildPath(tempdir, tempfile)
Loop
' Finally save a copy of the email...
message.SaveAs "path", olTXT
' If a file path string with embedded spaces is imported,
' it thinks each space delimits a new file name. To avoid this confusion,
' get the 8.3 format of the file path string...
Set Fil = fso.GetFile(path)
path = Fil.ShortPath
Set Fil = Nothing
ExecCmd "ttimport.exe " & app & " " & path
' Delete the file in the temporary directory...
' fso.DeleteFile path, True
Set fso = Nothing
End Sub
the code is to save an email as a .txt file and prepare it for importing to
our document repository. Not familiar with programming, we have tried to
work with the code below. Now, it keeps getting stuck at message.save as
part. Any suggestions?
Sub SaveToIDM_Claim()
Dim fso
Dim Fil
Dim ns As Outlook.NameSpace
Dim message As MailItem
Dim ext As String
Dim filename As String
Dim tempfile As String
Dim tempdir As String
Dim path As String
Dim del As String ' import delete parameter
Dim app As String 'import application parameter
' Set fso = New FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set ns = GetNamespace("MAPI")
' Change AppName to an import parameter...
app = "/a=clmdoc"
' Save a copy of the email to a file of the same name
' but in the system's temporary directory...
tempdir = fso.GetSpecialFolder(2)
filename = "importemail"
' If an email has not yet been saved, it does not have an extension
' So add an .txt extension...
If fso.GetExtensionName(filename) = "" Then
filename = filename & ".txt"
End If
' Save the extension...
ext = fso.GetExtensionName(filename)
path = fso.BuildPath(tempdir, filename)
' If a file with than name already exists,
' start generating random file names until one does not exist...
Do While fso.FileExists(path)
tempfile = fso.GetTempName
tempfile = fso.GetBaseName(tempfile) & "." & ext
path = fso.BuildPath(tempdir, tempfile)
Loop
' Finally save a copy of the email...
message.SaveAs "path", olTXT
' If a file path string with embedded spaces is imported,
' it thinks each space delimits a new file name. To avoid this confusion,
' get the 8.3 format of the file path string...
Set Fil = fso.GetFile(path)
path = Fil.ShortPath
Set Fil = Nothing
ExecCmd "ttimport.exe " & app & " " & path
' Delete the file in the temporary directory...
' fso.DeleteFile path, True
Set fso = Nothing
End Sub