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

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm


"ExcelLars" wrote in message
...
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

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