Re: Problem with saving .txt attachement

Hello Michael

Thank you so much for your help. Just fantastic. But working on the
function, below is my revised code which I encounter problem. "Compile Error:
Invalid Next Control variable reference"

Sub Mod9Rev2SaveEml_AtmtToFolder()

On Error GoTo Mod9Rev2SaveEml_AtmtToFolder_err

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 String
Dim strsender As String
Dim strDateTime As String
Dim strRead As String
Dim strSignature As String
Dim str1 As String
Dim i As Long
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 i = Item.Count To 1 Step -1
Set Item = SubFolder.Item(i)

strSubject = Item.Subject
strSubject = ReplaceStr(strSubject)

strsender = Item.SenderName
strsender = ReplaceStr(strsender)

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, "yymmdd_hhnnss_") & Left([strSubject],
100) & "_" & strsender & ".txt", olTXT
Item.SaveAs "C:\2006\" & _
Format(Item.CreationTime, "yymmdd_hhnnss_") & Left([strSubject],
100) & "_" & strsender & ".txt", olTXT

e = e + 1

For Each Atmt In Item.Attachments
FileName = "C:\Autosave\" & _
Format(Item.CreationTime, "yymmdd_hhnnss_") &
Left([strSubject], 100) & "_" & strsender & "_" & Atmt.FileName
Atmt.SaveAsFile FileName
FileName = "C:\2006\" & _
Format(Item.CreationTime, "yymmdd_hhnnss_") &
Left([strSubject], 100) & "_" & strsender & "_" & Atmt.FileName
Atmt.SaveAsFile FileName

i = i + 1
Next Atmt
Item.Move SubFolder1
Next Item 'Compile Error: Invalid Next Control variable reference


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


Mod9Rev2SaveEml_AtmtToFolder_exit:
Set Atmt = Nothing
Set Item = Nothing
Set NS = Nothing
Exit Sub

Mod9Rev2SaveEml_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 Mod9Rev2SaveEml_AtmtToFolder_exit
End Sub

Private Function ReplaceStr(str As String) As String

str = Replace(str, Chr(34), " ")
str = Replace(str, "/", " ")
str = Replace(str, "\", " ")
str = Replace(str, "<", " ")
str = Replace(str, ">", " ")
str = Replace(str, "&", " ")
str = Replace(str, "[", " ")
str = Replace(str, "]", " ")
str = Replace(str, "!", "")
str = Replace(str, "é", "e")
str = Replace(str, "(", " ")
str = Replace(str, ")", " ")
str = Replace(str, ":", " ")
str = Replace(str, "-", " ")
str = Replace(str, ",", " ")
str = Replace(str, ".", " ")
str = Replace(str, "?", " ")
str = Replace(str, "*", " ")
str = Replace(str, "°", " ")
str = Replace(str, ";", " ")
str = Replace(str, "#", " ")
str = Replace(str, "+", " ")
str = Replace(str, "@", " ")
str = Replace(str, ";", " ")
str = Replace(str, "=", " ")
str = Replace(str, "$", " dlr ")
str = Replace(str, "%", " percent ")
ReplaceStr = str
End Function


"Michael Bauer" wrote:

> Am Fri, 6 Jan 2006 01:16:04 -0800 schrieb norhaya:
>
> 1)
>
> You do have a sample for replacing the sendername already.
>
> >>> Item.Subject = Replace(Item.Subject, Chr(34), " ")
> >>>
> >>> strSubject = Item.Subject
>
> A simple change would do it:
>
> strSubject = Item.Subject
> strSubject = Replace(strSubject, Chr(34), " ")
>
> With that could you don´t change the Item itself, but read the subject into
> a variable and then change the variable. The same works for the sender.
>
> A good approach would be not to copy all the code, but use another function
> that could handle both the subject and the sender:
>
> Private Function ReplaceStr(str as string) as string
> str = Replace(str, Chr(34), " ")
> ' insert here all the other replace statements, too, and use
> ' the new variable 'str'
> ReplaceStr = str
> End function
>
> Sample for calling the function for the subject:
>
> strSubject = Item.Subject
> strSubject = ReplaceStr(strSubject)
>
> 2)
>
> In your code you have the line "For Each Item...". You need to replace that
> with:
>
> For i=Items.Count to 1 step -1
> Set Item = Subfolder.Item(i)
>
> That´s all.
>
> Maybe another point: In your code you have declared the variable 'i' as
> Integer. For attachments that´s surely ok. But now you´re using the same
> variable for the folder´s Items. A folder can contain more then 32767 items
> (upper bound for an integer), so you should declare it as Long instead.
>
> --
> Viele Gruesse / Best regards
> Michael Bauer - MVP Outlook
>
>
>
> > Mr Bauer
> >
> > Thank you for your prompt response, I will work on the cutting the string
> > for the attachement n let u know i made it.
> >
> > u mentioned that i could replace the sendername too, can you show sample
> > code. I've been trying to work on so many time, i was told by sue mosher
> that
> > sendername is read-only so i cannot change it. but if u can assist that
> will
> > be fantastic.
> >
> > sorry, i have to ask you where in my code that you suggested i replace
> with
> > this code
> >> For i=Items.Count to 1 step -1
> >> ....
> >> next
> >
> > thanks, norhaya
> > .
> >
> > "Michael Bauer" wrote:
> >
> >> 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

  • Search pattern
    ... Dim strfile As String ... Dim bAddressFound As Boolean ... Dim strCurrentChar As String ...
    (comp.databases.ms-access)
  • Re: multiplatform (pocketPC & desktopPC) (Daniel !!)
    ... Friend Versione As String ... Public Sub GetMyConnectionPalmare() ... Dim errorMessages As String ... Private Function GetDS_Desktop(ByVal SQL As String) As DataSet ...
    (microsoft.public.dotnet.framework.compactframework)
  • Re: multiplatform (pocketPC & desktopPC) (Daniel !!)
    ... Friend Versione As String ... Public Sub GetMyConnectionPalmare() ... Dim errorMessages As String ... Private Function GetDS_Desktop(ByVal SQL As String) As DataSet ...
    (microsoft.public.dotnet.framework.compactframework)
  • Help answer these 70-310 questions
    ... One argument is the string ... Dim output As New StringBuilder ... EmployeeLocations. ... You create a strongly named serviced component. ...
    (microsoft.public.cert.exam.mcad)
  • Help answer these 70-310 questions
    ... One argument is the string ... Dim output As New StringBuilder ... EmployeeLocations. ... You create a strongly named serviced component. ...
    (microsoft.public.cert.exam.mcsd)