Why will this code just change subject to only the fist selecteditem?

ExcelLars · May 14, 2008

Why will this code just change subject to only the fist selected item?

For x = 1 To myOlSel.Count
myOlSel.Item(x).Subject = strProsjektnrnavn &
myOlSel.Item(x).Subject 'ad a prefix in subject
Next x

Ken Slovak - [MVP - Outlook] · May 14, 2008

I'm surprised it would change anything, you're not saving your changes.

ExcelLars · May 14, 2008

This was not the whole code....

Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim strProsjektnrnavn, strProsjektnrnavnDel1,
strProsjektnrnavnDel2 As String
Dim x As Integer

Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
On Error Resume Next
strProsjektnrnavnDel1 = ""
strProsjektnrnavnDel2 = ""

'sjekker hva som er valgt i listeboksene i UserForm1
strProsjektnrnavnDel1 = ListBox1.Value
strProsjektnrnavnDel2 = ListBox2.Value

If CheckBox3 = True And CheckBox1 = True Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel1 & "] " & "[" & strProsjektnrnavnDel2 & "]
"
If CheckBox3 = True And CheckBox1 = False Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel1 & "] "
If CheckBox3 = False And CheckBox1 = True Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel2 & "] "
If CheckBox3 = False And CheckBox1 = False Then strProsjektnrnavn
= ""
'Stop
'Her blir det satt inn en prefix i emnefeltet og lagt inn kategori
hvis checkboks2 = true
For x = 1 To myOlSel.Count
Emne = myOlSel.Item(x).Subject
'myOlSel.Item(x).Subject = strProsjektnrnavn &
myOlSel.Item(x).Subject 'legger inn prefix i emne
myOlSel.Item(x).Subject = strProsjektnrnavn & Emne 'legger inn
prefix i emne
If CheckBox2 = True Then myOlSel.Item(x).Categories =
strProsjektnrnavnDel2 'legger inn kategori
If CheckBox4 = True Then myOlSel.Item(x).UnRead = False
'marker som lest
Next x

Ken Slovak - [MVP - Outlook] · May 15, 2008

You still aren't calling to save the changes.

ExcelLars · May 17, 2008

The first item change, but not next. How can I save changes for the
next items?

Ken Slovak - [MVP - Outlook] · May 19, 2008

What is your current code? Are you saving each item you modify in your loop?

ExcelLars · May 20, 2008

This code make a prefix to current subject, and it works fine. But if
have selected more than 1 item just the first item got the prefix.
The prefix will not show before I have selected another e-mail (that's
a problem too). Sorry but I'm a newbee to Outlook VBA.

myOlSel.Item(x).Subject = strProsjektnrnavn & Emne ' Emne = orginal
subject

Ken Slovak - [MVP - Outlook] · May 20, 2008

The code you are showing doesn't show you saving the item at all. Please
show the code I asked for that shows the entire For loop you are using. I
can't help you if you don't answer my questions or show the code snippets I
ask to see.

ExcelLars · May 21, 2008

Private Sub CommandButton1_Click()

Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim strProsjektnrnavn, strProsjektnrnavnDel1,
strProsjektnrnavnDel2 As String
Dim Mdato, Emne As String
Dim x As Integer

Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
On Error Resume Next
strProsjektnrnavnDel1 = ""
strProsjektnrnavnDel2 = ""

strProsjektnrnavnDel1 = ListBox1.Value
strProsjektnrnavnDel2 = ListBox2.Value

If strProsjektnrnavnDel1 = Null Then strProsjektnrnavnDel1 = ""
If strProsjektnrnavnDel2 = Null Then strProsjektnrnavnDel2 = ""

If CheckBox3 = True And CheckBox1 = True Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel1 & "] " & "[" & strProsjektnrnavnDel2 & "]
"
If CheckBox3 = True And CheckBox1 = False Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel1 & "] "
If CheckBox3 = False And CheckBox1 = True Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel2 & "] "
If CheckBox3 = False And CheckBox1 = False Then strProsjektnrnavn
= ""

For x = 1 To myOlSel.Count
Emne = myOlSel.Item(x).Subject
myOlSel.Item(x).Subject = strProsjektnrnavn & Emne
If CheckBox2 = True Then myOlSel.Item(x).Categories =
strProsjektnrnavnDel2
'If CheckBox4 = True Then myOlSel.Item(x).UnRead = False
If CheckBox7 = True Then
'Copies an email message and makes it a Task Item with a Due
Date of today
Dim objMsg As Outlook.MailItem, objTask As Outlook.TaskItem
Set objMsg = Application.ActiveExplorer.Selection.Item(1)
Set objTask = Application.CreateItem(olTaskItem)
objTask.Body = objMsg.Body
objTask.Subject = objMsg.Subject
objTask.DueDate = Now
objTask.Save

Else
End If
If OptionButton1 = True Then myOlSel.Item(x).UnRead = False
If OptionButton2 = True Then myOlSel.Item(x).UnRead = True
If CheckBox5 = True Then
Mdato = Format(Year(myOlSel.Item(x).ReceivedTime), yyyy)
Mdato = Mdato &
Format(Month(myOlSel.Item(x).ReceivedTime), "00")
Mdato = Mdato & Format(Day(myOlSel.Item(x).ReceivedTime),
"00")
Mdato = Mdato & " "
Mdato = Mdato & Format(Hour(myOlSel.Item(x).ReceivedTime),
"00")
Mdato = Mdato &
Format(Minute(myOlSel.Item(x).ReceivedTime), "00")
Mdato = Mdato &
Format(Second(myOlSel.Item(x).ReceivedTime), "00")

Avsendernavn = myOlSel.Item(x).SenderEmailAddress

If Left(Avsendernavn, 10) = "/O=xxxxxxxx" Then
lengde = InStr(Right(Avsendernavn, 5), "=")
Avsendernavn = Mid(Right(Avsendernavn, 5), lengde + 1,
5 - lengde)
Else
End If

Dim ar()
Dim i&
Dim ReplaceBy$
ReplaceBy = "_"
ar = Array(";", ":", ",", "\", "/", "*", "[", "]", "?",
"!", "'", "<", ">", "|", "$")
'ar = Array(";", ":")
For i = 0 To UBound(ar)
Emne = Replace(1, Emne, ar(i), ReplaceBy, vbTextCompare)
Next

filnavn = Mdato & " " & Avsendernavn & " " & Emne & ".MSG"
txtSti = TextBox1.Value

myOlSel.Item(x).SaveAs txtSti & filnavn, olMSG
txtA = "[A] "
myOlSel.Item(x).Subject = txtA & myOlSel.Item(x).Subject

Else
End If
If CheckBox6 = True Then myOlSel.Item(x).Delete

Next x
End Sub

Michael Bauer [MVP - Outlook] · May 21, 2008

As Ken told you, after changing the Subject, before the Next statement, you
don't save the item. Note, saving an item as a file doesn't save it also to
Outlook.

--
Best regards
Michael Bauer - MVP Outlook

: Outlook Categories? Category Manager Is Your Tool:
: <http://www.vboffice.net/product.html?pub=6&lang=en>

Am Wed, 21 May 2008 01:12:16 -0700 (PDT) schrieb ExcelLars:

Private Sub CommandButton1_Click()

Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim strProsjektnrnavn, strProsjektnrnavnDel1,
strProsjektnrnavnDel2 As String
Dim Mdato, Emne As String
Dim x As Integer

Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
On Error Resume Next
strProsjektnrnavnDel1 = ""
strProsjektnrnavnDel2 = ""

strProsjektnrnavnDel1 = ListBox1.Value
strProsjektnrnavnDel2 = ListBox2.Value

If strProsjektnrnavnDel1 = Null Then strProsjektnrnavnDel1 = ""
If strProsjektnrnavnDel2 = Null Then strProsjektnrnavnDel2 = ""

If CheckBox3 = True And CheckBox1 = True Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel1 & "] " & "[" & strProsjektnrnavnDel2 & "]
"
If CheckBox3 = True And CheckBox1 = False Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel1 & "] "
If CheckBox3 = False And CheckBox1 = True Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel2 & "] "
If CheckBox3 = False And CheckBox1 = False Then strProsjektnrnavn
= ""

For x = 1 To myOlSel.Count
Emne = myOlSel.Item(x).Subject
myOlSel.Item(x).Subject = strProsjektnrnavn & Emne
If CheckBox2 = True Then myOlSel.Item(x).Categories =
strProsjektnrnavnDel2
'If CheckBox4 = True Then myOlSel.Item(x).UnRead = False
If CheckBox7 = True Then
'Copies an email message and makes it a Task Item with a Due
Date of today
Dim objMsg As Outlook.MailItem, objTask As Outlook.TaskItem
Set objMsg = Application.ActiveExplorer.Selection.Item(1)
Set objTask = Application.CreateItem(olTaskItem)
objTask.Body = objMsg.Body
objTask.Subject = objMsg.Subject
objTask.DueDate = Now
objTask.Save

Else
End If
If OptionButton1 = True Then myOlSel.Item(x).UnRead = False
If OptionButton2 = True Then myOlSel.Item(x).UnRead = True
If CheckBox5 = True Then
Mdato = Format(Year(myOlSel.Item(x).ReceivedTime), yyyy)
Mdato = Mdato &
Format(Month(myOlSel.Item(x).ReceivedTime), "00")
Mdato = Mdato & Format(Day(myOlSel.Item(x).ReceivedTime),
"00")
Mdato = Mdato & " "
Mdato = Mdato & Format(Hour(myOlSel.Item(x).ReceivedTime),
"00")
Mdato = Mdato &
Format(Minute(myOlSel.Item(x).ReceivedTime), "00")
Mdato = Mdato &
Format(Second(myOlSel.Item(x).ReceivedTime), "00")

Avsendernavn = myOlSel.Item(x).SenderEmailAddress

If Left(Avsendernavn, 10) = "/O=xxxxxxxx" Then
lengde = InStr(Right(Avsendernavn, 5), "=")
Avsendernavn = Mid(Right(Avsendernavn, 5), lengde + 1,
5 - lengde)
Else
End If

Dim ar()
Dim i&
Dim ReplaceBy$
ReplaceBy = "_"
ar = Array(";", ":", ",", "\", "/", "*", "[", "]", "?",
"!", "'", "<", ">", "|", "$")
'ar = Array(";", ":")
For i = 0 To UBound(ar)
Emne = Replace(1, Emne, ar(i), ReplaceBy, vbTextCompare)
Next

filnavn = Mdato & " " & Avsendernavn & " " & Emne & ".MSG"
txtSti = TextBox1.Value

myOlSel.Item(x).SaveAs txtSti & filnavn, olMSG
txtA = "[A] "
myOlSel.Item(x).Subject = txtA & myOlSel.Item(x).Subject

Else
End If
If CheckBox6 = True Then myOlSel.Item(x).Delete

Next x
End Sub

Ken Slovak - [MVP - Outlook] · May 21, 2008

You still aren't saving the item in your loop. Right after this line of
code:

myOlSel.Item(x).Subject = txtA & myOlSel.Item(x).Subject

Put this:

myOlSel.Item(x).Save

ExcelLars said:
Private Sub CommandButton1_Click()

Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim strProsjektnrnavn, strProsjektnrnavnDel1,
strProsjektnrnavnDel2 As String
Dim Mdato, Emne As String
Dim x As Integer

Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
On Error Resume Next
strProsjektnrnavnDel1 = ""
strProsjektnrnavnDel2 = ""

strProsjektnrnavnDel1 = ListBox1.Value
strProsjektnrnavnDel2 = ListBox2.Value

If strProsjektnrnavnDel1 = Null Then strProsjektnrnavnDel1 = ""
If strProsjektnrnavnDel2 = Null Then strProsjektnrnavnDel2 = ""

If CheckBox3 = True And CheckBox1 = True Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel1 & "] " & "[" & strProsjektnrnavnDel2 & "]
"
If CheckBox3 = True And CheckBox1 = False Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel1 & "] "
If CheckBox3 = False And CheckBox1 = True Then strProsjektnrnavn =
"[" & strProsjektnrnavnDel2 & "] "
If CheckBox3 = False And CheckBox1 = False Then strProsjektnrnavn
= ""

For x = 1 To myOlSel.Count
Emne = myOlSel.Item(x).Subject
myOlSel.Item(x).Subject = strProsjektnrnavn & Emne
If CheckBox2 = True Then myOlSel.Item(x).Categories =
strProsjektnrnavnDel2
'If CheckBox4 = True Then myOlSel.Item(x).UnRead = False
If CheckBox7 = True Then
'Copies an email message and makes it a Task Item with a Due
Date of today
Dim objMsg As Outlook.MailItem, objTask As Outlook.TaskItem
Set objMsg = Application.ActiveExplorer.Selection.Item(1)
Set objTask = Application.CreateItem(olTaskItem)
objTask.Body = objMsg.Body
objTask.Subject = objMsg.Subject
objTask.DueDate = Now
objTask.Save

Else
End If
If OptionButton1 = True Then myOlSel.Item(x).UnRead = False
If OptionButton2 = True Then myOlSel.Item(x).UnRead = True
If CheckBox5 = True Then
Mdato = Format(Year(myOlSel.Item(x).ReceivedTime), yyyy)
Mdato = Mdato &
Format(Month(myOlSel.Item(x).ReceivedTime), "00")
Mdato = Mdato & Format(Day(myOlSel.Item(x).ReceivedTime),
"00")
Mdato = Mdato & " "
Mdato = Mdato & Format(Hour(myOlSel.Item(x).ReceivedTime),
"00")
Mdato = Mdato &
Format(Minute(myOlSel.Item(x).ReceivedTime), "00")
Mdato = Mdato &
Format(Second(myOlSel.Item(x).ReceivedTime), "00")

Avsendernavn = myOlSel.Item(x).SenderEmailAddress

If Left(Avsendernavn, 10) = "/O=xxxxxxxx" Then
lengde = InStr(Right(Avsendernavn, 5), "=")
Avsendernavn = Mid(Right(Avsendernavn, 5), lengde + 1,
5 - lengde)
Else
End If

Dim ar()
Dim i&
Dim ReplaceBy$
ReplaceBy = "_"
ar = Array(";", ":", ",", "\", "/", "*", "[", "]", "?",
"!", "'", "<", ">", "|", "$")
'ar = Array(";", ":")
For i = 0 To UBound(ar)
Emne = Replace(1, Emne, ar(i), ReplaceBy, vbTextCompare)
Next

filnavn = Mdato & " " & Avsendernavn & " " & Emne & ".MSG"
txtSti = TextBox1.Value

myOlSel.Item(x).SaveAs txtSti & filnavn, olMSG
txtA = "[A] "
myOlSel.Item(x).Subject = txtA & myOlSel.Item(x).Subject

Else
End If
If CheckBox6 = True Then myOlSel.Item(x).Delete

Next x
End Sub

ExcelLars · May 21, 2008

Sorry i'm newbee to programing. Thank You for all help! Now it works!

Printing Tiff/JPG attachment	4	Mar 18, 2009
Custom Archive code -- modify my code!	3	Nov 17, 2009
How to use macro (OL2007) to assign categories to group of message	4	Sep 8, 2008
vba to vb .net	0	Jun 21, 2005
Using Clipboad in Outlook VBA	3	Oct 24, 2005
Printing TIFF/JPG Attachments	1	Mar 19, 2009
Change in subject shows only after I select another e-mail	1	May 20, 2008
my first add in	0	Jun 22, 2005

Why will this code just change subject to only the fist selecteditem?

ExcelLars

Ken Slovak - [MVP - Outlook]

ExcelLars

Ken Slovak - [MVP - Outlook]

ExcelLars

Ken Slovak - [MVP - Outlook]

ExcelLars

Ken Slovak - [MVP - Outlook]

ExcelLars

Michael Bauer [MVP - Outlook]

Ken Slovak - [MVP - Outlook]

ExcelLars

Ask a Question

Similar Threads