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

  • Thread starter Thread starter ExcelLars
  • Start date Start date
E

ExcelLars

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
 
I'm surprised it would change anything, you're not saving your changes.
 
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
 
What is your current code? Are you saving each item you modify in your loop?
 
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
 
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.
 
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
 
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
Click to expand...
 
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
Click to expand...
 
Back
Top