Shorten file name

  • Thread starter Thread starter hlock
  • Start date Start date
H

hlock

I have vba in Outlook 2007 that saves each attachment on an email and imports
it to our document repository system. However, I need to remove spaces in
the file name because if the file path string with embedded spaces is passed
to the import program, it thinks each space delimits a new file name. I need
to get the 8.3 format of the file path string. Here is what I have currently:

For Each objMsg In objSelection
' This code only strips attachments from mail items.
If objMsg.Class = olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
' We need to use a count down loop for
' removing items from a collection. Otherwise,
' the loop counter gets confused and only every
' other item is removed.
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
strfile = objAttachments.Item(i).FileName
' Combine with the path to the Temp folder.
strfile = strFolder & strfile
' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strfile
' Delete the attachment.
'objAttachments.Item(i).Delete

ExecCmd "ttimport.exe " & app & " " & strfile
Next i
End If
objMsg.Save
End If
Next

I know that I need to put something in here to shorten the file name, but
I'm not sure where and how. Any help is appreciated. Thanks!
 
Perfect!!! If I may... my current code works only for an email in explorer.
How do I modify it so that it will either work for the email selected in a
folder or an open email? I tried using what you gave me the other day, but
it's not working. Here is the entire code:

Public Sub StripAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strfile As String
Dim strFolder As String
Dim del As String ' ttimport delete parameter
Dim app As String ' ttimport application parameter
Dim result

On Error Resume Next

result = MsgBox("Do you want to remove attachments from selected
email(s)?", vbYesNo + vbQuestion)
If result = vbNo Then
Exit Sub
End If

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' Get the Temp folder.
strFolder = GetTempDir()
If strFolder = "" Then
MsgBox "Could not get Temp folder", vbOKOnly
GoTo ExitSub
End If

app = "/a=clmdoc"


' Check each selected item for attachments.
' If attachments exist, save them to the Temp
' folder and strip them from the item.
For Each objMsg In objSelection
' This code only strips attachments from mail items.
If objMsg.Class = olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
' We need to use a count down loop for
' removing items from a collection. Otherwise,
' the loop counter gets confused and only every
' other item is removed.
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
strfile = objAttachments.item(i).FileName
strfile = Replace(strfile, " ", "_")
'Combine with the path to the Temp folder.
strfile = strFolder & strfile
' Save the attachment as a file.
objAttachments.item(i).SaveAsFile strfile
' Delete the attachment.
'objAttachments.Item(i).Delete

ExecCmd "ttimport.exe " & app & " " & strfile
Next i
End If
objMsg.Save
End If
Next
Call ImportAttMacro

ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

You don't know how much we appreciate this community's help. There is a lot
of things that we wouldn't be able to do without it.
 
See http://www.outlookcode.com/codedetail.aspx?id=50 for a function that
will return the currently open or selected item.

If something isn't working, you need to tell us exactly what the symptoms
are.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


hlock said:
Perfect!!! If I may... my current code works only for an email in
explorer.
How do I modify it so that it will either work for the email selected in a
folder or an open email? I tried using what you gave me the other day,
but
it's not working. Here is the entire code:

Public Sub StripAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strfile As String
Dim strFolder As String
Dim del As String ' ttimport delete parameter
Dim app As String ' ttimport application parameter
Dim result

On Error Resume Next

result = MsgBox("Do you want to remove attachments from selected
email(s)?", vbYesNo + vbQuestion)
If result = vbNo Then
Exit Sub
End If

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' Get the Temp folder.
strFolder = GetTempDir()
If strFolder = "" Then
MsgBox "Could not get Temp folder", vbOKOnly
GoTo ExitSub
End If

app = "/a=clmdoc"


' Check each selected item for attachments.
' If attachments exist, save them to the Temp
' folder and strip them from the item.
For Each objMsg In objSelection
' This code only strips attachments from mail items.
If objMsg.Class = olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
' We need to use a count down loop for
' removing items from a collection. Otherwise,
' the loop counter gets confused and only every
' other item is removed.
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
strfile = objAttachments.item(i).FileName
strfile = Replace(strfile, " ", "_")
'Combine with the path to the Temp folder.
strfile = strFolder & strfile
' Save the attachment as a file.
objAttachments.item(i).SaveAsFile strfile
' Delete the attachment.
'objAttachments.Item(i).Delete

ExecCmd "ttimport.exe " & app & " " & strfile
Next i
End If
objMsg.Save
End If
Next
Call ImportAttMacro

ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
Click to expand...
 
Back
Top