Hoi.
Ik heb eerst uiteraard gezocht of ik iets over mijn probleem zou kunnen vinden op Helpmij.nl, maar ik kom dit specifieke probleem niet tegen.
Wat ik graag wil is RSS feeds ontvangen in Outlook (2007 en 2010). Op zich koud kunstje zou je zeggen, ware het niet dat ik tegen het probleem aan loop dat ik de feeds zelf op één dag dubbel, soms driedubbel ontvang. Irritant. Na lang op verschillende fora gezocht te hebben kom ik tot de conclusie dat dit echt een issue is in Outlook zelf dat ik niet opgelost ga krijgen. MS erkent het probleem overigens (https://support.microsoft.com/en-us/kb/956959) maar de door hun geboden work around levert mij niets op. Ook op bijvoorbeeld dit forum lees ik dat er veel gebruikers zijn met idem probleem, helaas vinden ook zij geen permanente oplossing hiervoor (https://social.technet.microsoft.co...s-feedsmultiple-copies-of-posts?forum=outlook).
Nu heb ik ook gekeken of ik op de een of andere manier in Outlook via 'Regels' iets zo zou kunnen instellen dat Outlook vanzelf dubbele emails herkent en naar een door mij aangewezen map verplaatst. Dus iets met if-then-else. Maar een dergelijke functie kan ik niet vinden. Vraag me ook af hoe dat zou kunnen überhaupt.
Maar goed. Nu het werkelijke VBA probleem; op deze website http://www.outlook.pl/Tworzenie-wasnego-programu-Lekcja-1-Usuniecie-duplikatow/430/#f kwam ik een post tegen van een Poolse VBA ontwikkelaar (voor mij toevallig handig want ik spreek die taal...) waarin hij uitlegt dat je met een door hem geschreven macro wel degelijk emails (dus ik gok ook RSS feeds) kan ontdubbelen. Hij levert via deze link 2 bestanden aan (http://www.outlook.pl/article/upload/Kill_Duplicate.zip): 1 *.frm en 1 *.frx bestand. De *.frm zou ik in VBA moeten importeren en vervolgens via een nieuwe module moeten aanmaken met daarin deze code :
Option Explicit
Sub Wywolanie()
Kill_Duplicate.Show
End Sub
Dit alles zou tot gevolg moeten hebben dat ik de ontdubbelende functie gestart zou kunnen worden, echter; ik loop tegen de volgende foutmelding aan in VBA:
Ik heb al gecheckt of ik op mijn Win7 laptop beschik over het MSCOMCTL.OCX bestand en dat heb ik. Ook heb ik in VBA via Extra-->Verwijzingen gecontroleerd of daar de juiste opties aangevinkt zijn, ik heb nu de volgende aan staan:
Hierbij nog even de volledige code:
Option Explicit
Dim oFolder As MAPIFolder
Dim item As Object, i&
Dim KillItem As MailItem
Private Sub Anuluj_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim clmX As ColumnHeader
With Lista
Set clmX = .ColumnHeaders.Add(, , "Utworzono", .Width / 6.02)
Set clmX = .ColumnHeaders.Add(, , "Nadawca", .Width / 4)
Set clmX = .ColumnHeaders.Add(, , "Rozmiar [kb]", .Width / 10)
Set clmX = .ColumnHeaders.Add(, , "Temat", .Width / 2)
Set clmX = .ColumnHeaders.Add(, , "EntryID", .Width / 2)
Set clmX = Nothing
End With
With Application.ActiveExplorer.CurrentFolder
Ilosc.Caption = "IloϾ 0" & .Items.Count
Me.Caption = Me.Caption & " " & Chr(34) & .Name & Chr(34)
Me.Height = 309
End With
End Sub
Private Sub Czytaj_Click()
Dim item As Object, itmX As ListItem, dodany&
Delete_d.Enabled = False
Anuluj.Enabled = False
Wielkosc.Enabled = False
Lista.ListItems.Clear
dodany = 0
Set oFolder = Application.ActiveExplorer.CurrentFolder
For Each item In oFolder.Items
DoEvents
On Error Resume Next
Set itmX = Lista.ListItems.Add(, , item.CreationTime)
itmX.SubItems(1) = item.SenderEmailAddress
itmX.SubItems(2) = Format(item.Size, "# ###")
itmX.SubItems(3) = item.Subject
itmX.SubItems(4) = item.EntryID
dodany = dodany + 1
On Error GoTo 0
Ilosc.Caption = "IloϾ " & dodany & "" & oFolder.Items.Count
Next item
Set itmX = Nothing
Delete_d.Enabled = True
Anuluj.Enabled = True
Wielkosc.Enabled = True
End Sub
Private Sub Delete_d_Click()
Set oFolder = Application.ActiveExplorer.CurrentFolder
If oFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems) Then
Dim Pytanie
Pytanie = MsgBox("Znajdujesz siê w folderze " & Chr(34) & _
Application.ActiveExplorer.CurrentFolder.Name & Chr(34) & vbCr & _
"Uruchomienie procedury permanentnie usunie elementy z tego folderu." & vbCr & _
"Czy kontynuowaæ?", vbQuestion + vbDefaultButton2 + vbYesNo, "VBATools.pl")
If Pytanie = vbNo Then Exit Sub
End If
If Lista.ListItems.Count < 1 Then MsgBox "Brak elementów do porównania", _
vbInformation, "VBATools.pl": Exit Sub
With Progress
.Top = 264
.value = 0
.max = Lista.ListItems.Count
.Visible = True
End With
Delete_d.Visible = False
Czytaj.Visible = False
Anuluj.Visible = False
Ilosc.Visible = False
Wielkosc.Visible = False
Lista.Sorted = True
Dim ile&: ile = 0
For i = 1 To Lista.ListItems.Count - 1
DoEvents
Progress.value = i
If Wielkosc.value = True Then
If Lista.ListItems(i) & Lista.ListItems(i).ListSubItems(1) & _
Lista.ListItems(i).ListSubItems(3) = _
Lista.ListItems(i + 1) & Lista.ListItems(i + 1).ListSubItems(1) & _
Lista.ListItems(i + 1).ListSubItems(3) Then
Call DeleteItem(Lista.ListItems(i).ListSubItems(4))
ile = ile + 1
End If
Else
If Lista.ListItems(i) & Lista.ListItems(i).ListSubItems(1) & _
Lista.ListItems(i).ListSubItems(2) & _
Lista.ListItems(i).ListSubItems(3) = _
Lista.ListItems(i + 1) & Lista.ListItems(i + 1).ListSubItems(1) & _
Lista.ListItems(i + 1).ListSubItems(2) & _
Lista.ListItems(i + 1).ListSubItems(3) Then
Call DeleteItem(Lista.ListItems(i).ListSubItems(4))
ile = ile + 1
End If
End If
Next i
If ile > 0 Then
MsgBox "Umieszczono w folderze " & Chr(34) & _
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).Name & Chr(34) & _
" " & ile & " wiadomoœci", vbExclamation, "VBATools.pl"
Else
MsgBox "Nie znaleziono ¿adnych duplikatów w folderze " & oFolder.Name, _
vbInformation, "VBATools.pl"
End If
Progress.Visible = False
Delete_d.Visible = True
Czytaj.Visible = True
Anuluj.Visible = True
Ilosc.Visible = True
Wielkosc.Visible = True
End Sub
Private Sub DeleteItem(ByVal targetItem$)
Set oFolder = Application.ActiveExplorer.CurrentFolder
For Each item In oFolder.Items
DoEvents
If item.EntryID = targetItem Then item.Delete
Next item
Set oFolder = Nothing
End Sub
Private Sub UserForm_Terminate()
Set KillItem = Nothing
Set oFolder = Nothing
End Sub
Kan iemand mij helpen met deze foutmelding? Waardoor ontstaat deze en hoe kan ik die oplossen? Alvast enorm bedankt!
p.s. alternatieven voor het verwijderen van dubbele emails in Outlook zijn zeer welkom, ik wil echter geen gebruik maken van 3rd party software (ik weet dat deze bestaat).
Groet, therisque.
Ik heb eerst uiteraard gezocht of ik iets over mijn probleem zou kunnen vinden op Helpmij.nl, maar ik kom dit specifieke probleem niet tegen.
Wat ik graag wil is RSS feeds ontvangen in Outlook (2007 en 2010). Op zich koud kunstje zou je zeggen, ware het niet dat ik tegen het probleem aan loop dat ik de feeds zelf op één dag dubbel, soms driedubbel ontvang. Irritant. Na lang op verschillende fora gezocht te hebben kom ik tot de conclusie dat dit echt een issue is in Outlook zelf dat ik niet opgelost ga krijgen. MS erkent het probleem overigens (https://support.microsoft.com/en-us/kb/956959) maar de door hun geboden work around levert mij niets op. Ook op bijvoorbeeld dit forum lees ik dat er veel gebruikers zijn met idem probleem, helaas vinden ook zij geen permanente oplossing hiervoor (https://social.technet.microsoft.co...s-feedsmultiple-copies-of-posts?forum=outlook).
Nu heb ik ook gekeken of ik op de een of andere manier in Outlook via 'Regels' iets zo zou kunnen instellen dat Outlook vanzelf dubbele emails herkent en naar een door mij aangewezen map verplaatst. Dus iets met if-then-else. Maar een dergelijke functie kan ik niet vinden. Vraag me ook af hoe dat zou kunnen überhaupt.
Maar goed. Nu het werkelijke VBA probleem; op deze website http://www.outlook.pl/Tworzenie-wasnego-programu-Lekcja-1-Usuniecie-duplikatow/430/#f kwam ik een post tegen van een Poolse VBA ontwikkelaar (voor mij toevallig handig want ik spreek die taal...) waarin hij uitlegt dat je met een door hem geschreven macro wel degelijk emails (dus ik gok ook RSS feeds) kan ontdubbelen. Hij levert via deze link 2 bestanden aan (http://www.outlook.pl/article/upload/Kill_Duplicate.zip): 1 *.frm en 1 *.frx bestand. De *.frm zou ik in VBA moeten importeren en vervolgens via een nieuwe module moeten aanmaken met daarin deze code :
Option Explicit
Sub Wywolanie()
Kill_Duplicate.Show
End Sub
Dit alles zou tot gevolg moeten hebben dat ik de ontdubbelende functie gestart zou kunnen worden, echter; ik loop tegen de volgende foutmelding aan in VBA:
Ik heb al gecheckt of ik op mijn Win7 laptop beschik over het MSCOMCTL.OCX bestand en dat heb ik. Ook heb ik in VBA via Extra-->Verwijzingen gecontroleerd of daar de juiste opties aangevinkt zijn, ik heb nu de volgende aan staan:
Hierbij nog even de volledige code:
Option Explicit
Dim oFolder As MAPIFolder
Dim item As Object, i&
Dim KillItem As MailItem
Private Sub Anuluj_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim clmX As ColumnHeader
With Lista
Set clmX = .ColumnHeaders.Add(, , "Utworzono", .Width / 6.02)
Set clmX = .ColumnHeaders.Add(, , "Nadawca", .Width / 4)
Set clmX = .ColumnHeaders.Add(, , "Rozmiar [kb]", .Width / 10)
Set clmX = .ColumnHeaders.Add(, , "Temat", .Width / 2)
Set clmX = .ColumnHeaders.Add(, , "EntryID", .Width / 2)
Set clmX = Nothing
End With
With Application.ActiveExplorer.CurrentFolder
Ilosc.Caption = "IloϾ 0" & .Items.Count
Me.Caption = Me.Caption & " " & Chr(34) & .Name & Chr(34)
Me.Height = 309
End With
End Sub
Private Sub Czytaj_Click()
Dim item As Object, itmX As ListItem, dodany&
Delete_d.Enabled = False
Anuluj.Enabled = False
Wielkosc.Enabled = False
Lista.ListItems.Clear
dodany = 0
Set oFolder = Application.ActiveExplorer.CurrentFolder
For Each item In oFolder.Items
DoEvents
On Error Resume Next
Set itmX = Lista.ListItems.Add(, , item.CreationTime)
itmX.SubItems(1) = item.SenderEmailAddress
itmX.SubItems(2) = Format(item.Size, "# ###")
itmX.SubItems(3) = item.Subject
itmX.SubItems(4) = item.EntryID
dodany = dodany + 1
On Error GoTo 0
Ilosc.Caption = "IloϾ " & dodany & "" & oFolder.Items.Count
Next item
Set itmX = Nothing
Delete_d.Enabled = True
Anuluj.Enabled = True
Wielkosc.Enabled = True
End Sub
Private Sub Delete_d_Click()
Set oFolder = Application.ActiveExplorer.CurrentFolder
If oFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems) Then
Dim Pytanie
Pytanie = MsgBox("Znajdujesz siê w folderze " & Chr(34) & _
Application.ActiveExplorer.CurrentFolder.Name & Chr(34) & vbCr & _
"Uruchomienie procedury permanentnie usunie elementy z tego folderu." & vbCr & _
"Czy kontynuowaæ?", vbQuestion + vbDefaultButton2 + vbYesNo, "VBATools.pl")
If Pytanie = vbNo Then Exit Sub
End If
If Lista.ListItems.Count < 1 Then MsgBox "Brak elementów do porównania", _
vbInformation, "VBATools.pl": Exit Sub
With Progress
.Top = 264
.value = 0
.max = Lista.ListItems.Count
.Visible = True
End With
Delete_d.Visible = False
Czytaj.Visible = False
Anuluj.Visible = False
Ilosc.Visible = False
Wielkosc.Visible = False
Lista.Sorted = True
Dim ile&: ile = 0
For i = 1 To Lista.ListItems.Count - 1
DoEvents
Progress.value = i
If Wielkosc.value = True Then
If Lista.ListItems(i) & Lista.ListItems(i).ListSubItems(1) & _
Lista.ListItems(i).ListSubItems(3) = _
Lista.ListItems(i + 1) & Lista.ListItems(i + 1).ListSubItems(1) & _
Lista.ListItems(i + 1).ListSubItems(3) Then
Call DeleteItem(Lista.ListItems(i).ListSubItems(4))
ile = ile + 1
End If
Else
If Lista.ListItems(i) & Lista.ListItems(i).ListSubItems(1) & _
Lista.ListItems(i).ListSubItems(2) & _
Lista.ListItems(i).ListSubItems(3) = _
Lista.ListItems(i + 1) & Lista.ListItems(i + 1).ListSubItems(1) & _
Lista.ListItems(i + 1).ListSubItems(2) & _
Lista.ListItems(i + 1).ListSubItems(3) Then
Call DeleteItem(Lista.ListItems(i).ListSubItems(4))
ile = ile + 1
End If
End If
Next i
If ile > 0 Then
MsgBox "Umieszczono w folderze " & Chr(34) & _
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).Name & Chr(34) & _
" " & ile & " wiadomoœci", vbExclamation, "VBATools.pl"
Else
MsgBox "Nie znaleziono ¿adnych duplikatów w folderze " & oFolder.Name, _
vbInformation, "VBATools.pl"
End If
Progress.Visible = False
Delete_d.Visible = True
Czytaj.Visible = True
Anuluj.Visible = True
Ilosc.Visible = True
Wielkosc.Visible = True
End Sub
Private Sub DeleteItem(ByVal targetItem$)
Set oFolder = Application.ActiveExplorer.CurrentFolder
For Each item In oFolder.Items
DoEvents
If item.EntryID = targetItem Then item.Delete
Next item
Set oFolder = Nothing
End Sub
Private Sub UserForm_Terminate()
Set KillItem = Nothing
Set oFolder = Nothing
End Sub
Kan iemand mij helpen met deze foutmelding? Waardoor ontstaat deze en hoe kan ik die oplossen? Alvast enorm bedankt!
p.s. alternatieven voor het verwijderen van dubbele emails in Outlook zijn zeer welkom, ik wil echter geen gebruik maken van 3rd party software (ik weet dat deze bestaat).
Groet, therisque.
