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

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

Am Tue, 10 Jan 2006 20:18:02 -0800 schrieb norhaya:

For i = Item.Count To 1 Step -1

In your code "Item" is a variable for one single item. The list which
contains all these items is (in your code) SubFolder.Items. So the For
statement has to be:

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

The control variable in that loop is i. So if you want to mention the
control variable together with the Next statement (you don´t need to) then
you must write

....
Next i

Also allowed is simple

....
Next

(without the control variable).

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



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

Hi Michael

Thank you once again. it helps alot n no more headaches

"Michael Bauer" wrote:

Am Tue, 10 Jan 2006 20:18:02 -0800 schrieb norhaya:

For i = Item.Count To 1 Step -1

In your code "Item" is a variable for one single item. The list which
contains all these items is (in your code) SubFolder.Items. So the For
statement has to be:

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

The control variable in that loop is i. So if you want to mention the
control variable together with the Next statement (you don´t need to) then
you must write

....
Next i

Also allowed is simple

....
Next

(without the control variable).

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



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