Re: Problem with saving .txt attachement

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

Am Thu, 5 Jan 2006 19:47:02 -0800 schrieb norhaya:

You can cut a string e.g. with the Left function: Left(txt, 8) returns the
first 8 characters of txt.

With the many Replace function calls you replace some characters, which
aren´t allowed for file names (and some other characters, too) by blank
spaces. Then for the file name you use also the SenderName, which also can
contain not allowed chars ("<" e.g.). That is, you need to qualify that
string, too.

You will need to change the For Each Item loop. Because you´re moving the
item at the end out of the list you can use e.g. a backwards loop:

For i=Items.Count to 1 step -1
....
next

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook



> Hi
>
> I've problems with saving any attached in text format, or attachement name
> is long, also when subject is long too.
>
> pls advise
>
> 1) if outlook having problem in saving .txt file which is an attachement?
> 2) how can i shorten the attachement name or subject name automatically.
can
> you show me the sample code.
>
> appreciate the help very much.
>
> below is my code
>
> Dim NS As NameSpace
> Dim Inbox As MAPIFolder
> Dim SubFolder As MAPIFolder
> Dim SubFolder1 As MAPIFolder
> Dim Item As Object
> Dim Atmt As Attachment
> Dim FileName As String
> Dim strSubject As Variant
> Dim strsender As Variant
> Dim strDateTime As String
> Dim strRead As String
> Dim strSignature As String
> Dim str1 As String
> Dim i As Integer
> Dim e As Integer
> Dim varResponse As VbMsgBoxResult
>
> Set NS = GetNamespace("MAPI")
> Set Inbox = NS.GetDefaultFolder(olFolderInbox)
> Set SubFolder = Inbox.Folders("AutoSave")
> Set SubFolder1 = Inbox.Folders("AutoSaved")
> e = 0
> i = 0
> str1 = ""
>
> If SubFolder.Items.Count = 0 Then
> MsgBox "There are no messages in the folder.", vbInformation, _
> "Nothing Found"
> Exit Sub
> End If
>
> For Each Item In SubFolder.Items
> Item.Subject = Replace(Trim(Item.Subject), ":", " ")
> Item.Subject = Replace(Trim(Item.Subject), "/", " ")
> Item.Subject = Replace(Trim(Item.Subject), "\", " ")
> Item.Subject = Replace(Trim(Item.Subject), "-", " ")
> Item.Subject = Replace(Trim(Item.Subject), ",", " ")
> Item.Subject = Replace(Trim(Item.Subject), "<", " ")
> Item.Subject = Replace(Trim(Item.Subject), ">", " ")
> Item.Subject = Replace(Trim(Item.Subject), ".", " ")
> Item.Subject = Replace(Trim(Item.Subject), "&", " ")
> Item.Subject = Replace(Trim(Item.Subject), "!", " ")
> Item.Subject = Replace(Trim(Item.Subject), "!!", " ")
> Item.Subject = Replace(Trim(Item.Subject), "é", "e")
> Item.Subject = Replace(Trim(Item.Subject), "(", " ")
> Item.Subject = Replace(Trim(Item.Subject), ")", " ")
> Item.Subject = Replace(Trim(Item.Subject), "?", " ")
> Item.Subject = Replace(Trim(Item.Subject), "*", " ")
> Item.Subject = Replace(Trim(Item.Subject), "°", " ")
> Item.Subject = Replace(Trim(Item.Subject), "[", " ")
> Item.Subject = Replace(Trim(Item.Subject), "]", " ")
> Item.Subject = Replace(Trim(Item.Subject), ";", " ")
> Item.Subject = Replace(Trim(Item.Subject), "#", " ")
> Item.Subject = Replace(Trim(Item.Subject), "+", " ")
> Item.Subject = Replace(Trim(Item.Subject), "@", " ")
> Item.Subject = Replace(Trim(Item.Subject), ";", " ")
> Item.Subject = Replace(Trim(Item.Subject), "=", " ")
> Item.Subject = Replace(Trim(Item.Subject), "$", " dlr ")
> Item.Subject = Replace(Trim(Item.Subject), "%", " percent ")
> Item.Subject = Replace(Item.Subject, Chr(34), " ")
>
> strSubject = Item.Subject
> strsender = Item.SenderName
> strDateTime = Now()
> strRead = " - *(Read by NS on - "
> strSignature = "(this email saved by Norhaya on - "
>
> Item.Subject = Item.Subject & strRead & strDateTime & ")"
> Item.Body = vbCrLf & Item.Body & strSignature & strDateTime & ")"
> Item.SaveAs "C:\Autosave\" & _
> Format(Item.CreationTime, "yyyymmdd_hhnnss_") & strSubject &
"_"
> & strsender & ".txt", olTXT
> Item.SaveAs "C:\Documents and
> Settings\ops7\Desktop\Norhaya\E-Filing\SCANNED DOC\Emails And Attachement
-
> Saved\" & _
> Format(Item.CreationTime, "yyyymmdd_hhnnss_") & strSubject &
"_"
> & strsender & ".txt", olTXT
>
> e = e + 1
>
> For Each Atmt In Item.Attachments
> FileName = "C:\Autosave\" & _
> Format(Item.CreationTime, "yyyymmdd_hhnnss_") &
> strSubject & "_" & strsender & "_" & Atmt.FileName
> Atmt.SaveAsFile FileName
> FileName = "C:\Documents and
> Settings\ops7\Desktop\Norhaya\E-Filing\SCANNED DOC\Emails And Attachement
-
> Saved\" & _
> Format(Item.CreationTime, "yyyymmdd_hhnnss_") &
> strSubject & "_" & strsender & "_" & Atmt.FileName
> Atmt.SaveAsFile FileName
>
> i = i + 1
> Next Atmt
> Item.Move SubFolder1
> Next Item
>
> If e > 0 Or i > 0 Then
> varResponse = MsgBox("I found " & e & " messages + " & i & "
> attachments in autosave folder." _
> & vbCrLf & "I have saved them into the C:\Autosave\ folder." _
> & vbCrLf & vbCrLf & "Would you like to view the files now?" _
> , vbQuestion + vbYesNo, "Finished!")
>
> If varResponse = vbYes Then
> Shell "Explorer.exe /e,C:\Autosave\ ", vbNormalFocus
> End If
> Else
> MsgBox "I didn't find any messages in your autosave folder.",
> vbInformation, "Finished!"
> End If
>
>
> Mod9SaveEml_AtmtToFolder_exit:
> Set Atmt = Nothing
> Set Item = Nothing
> Set NS = Nothing
> Exit Sub
>
> Mod9SaveEml_AtmtToFolder_err:
> MsgBox "An unexpected error has occurred." _
> & vbCrLf & "Please note and report the following information." _
> & vbCrLf & "Macro Name: GetAttachments" _
> & vbCrLf & "Error Number: " & Err.Number _
> & vbCrLf & "Error Description: " & Err.Description _
> , vbCritical, "Error!"
> Resume Mod9SaveEml_AtmtToFolder_exit
.

Relevant Pages

  • Re: Byte Array to String
    ... retrieved text will mismatch the original characters. ... encoding the characters. ... Dim strFileData as String ...
    (microsoft.public.dotnet.framework.aspnet)
  • Search pattern
    ... Dim strfile As String ... Dim bAddressFound As Boolean ... Dim strCurrentChar As String ...
    (comp.databases.ms-access)
  • Re: to remove all except hex characters and then validate
    ... Douglas' function allowed unlimited characters that would then strip out all ... Public Function OnlyHexCharacters(InputString As String) As String ... Dim strCurrChar As String ... Dim strOutput As String ...
    (microsoft.public.access.formscoding)
  • HTMLEncode: low surrogate char Error
    ... UTF characters that are part of the default windows code page throw an ... you will avoid throwing the exception. ... Dim _textStreamReader As StreamReader ... Function GetResource(ByVal ResourceName As String) ...
    (microsoft.public.dotnet.general)
  • Re: Linking from a mailing address in the database to maps.google.
    ... > unsafe, it was inputting the hex value, which wasn't working. ... > with this particular event procedure, given the limited characters ... >>> Dim stAddress As String ...
    (microsoft.public.access.formscoding)