Script i forbindelse med Outlook

Det skulle nok være muligt - vender tilbage..

Version 1'Rem Reference til Outlook via "Tools / References"
Rem ==============================================
Dim kontonr
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$D$1" Then
        Cancel = True
        traverserMailBoks
    End If
   
    MsgBox "Gennemløb afsluttet"
End Sub
Private Sub traverserMailBoks()
Dim OlApp, Namespace, mailObject, m As Integer, videreSendesTil As String, myForward
    Set OlApp = CreateObject("Outlook.Application")
    Set Namespace = OlApp.GetNamespace("MAPI")
    Set cfold = Namespace.GetDefaultFolder(olFolderInbox)
    antalMails = cfold.Items.Count

    If antalMails > 0 Then
        For m = 1 To antalMails
            Set mailObject = cfold.Items(m)
            kontonr = Left(mailObject.Subject, 4)          'test
            If IsNumeric(kontonr) = True Then              'test
                videreSendesTil = findVidereSendesTil(kontonr)
                If videreSendesTil <> "" Then
                    Set myForward = mailObject.Forward
                    myForward.Recipients.Add videreSendesTil
                    myForward.Send
                    mailObject.UnRead = False
                                                            'hvad skal der ske med mailen efter den er videresendt?
                Else
                    MsgBox "Mailadresse til kontonr.: " & CStr(kontonr) & " kunne ikke findes"
                End If
            End If
        Next m
    End If
End Sub
Private Function findVidereSendesTil(kontonr)
Dim ræk As Integer, antalRæk As Integer
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
    For ræk = 2 To antalRæk
        If kontonr = CStr(Range("A" & ræk)) Then
            findVidereSendesTil = Range("B" & ræk)
            Exit Function
        End If
    Next ræk
   
    findVidereSendesTil = ""
End Function

hej Supertekst
Det ser rigtigt fint ud - er ved at teste det.

Når en mail er afsendt så skal den flyttes til en undermappe, der har navn efter den pågældende måned og år.

Kontonavnet består ikke kun af numeriske tal, der er et bogstav + nogle tal.

Hvordan sætter jeg en path, således at jeg i forbindelse med test kan få koden til at se i en undermappe, når den skal tjekke for ubehandlede mails.

Det undre mig, at når den løber mappen igennem for mails, så starter den med den ældste først, hvorfor det? m har da værdie 1. så vil jeg da forvente at den starter forfra. Hvad er årsagen?

Rem Version 2
Rem Reference til Outlook via "Tools / References"
Rem ==============================================
Dim arkivMappe As Outlook.Folder
Dim kontonr
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$D$1" Then
        Cancel = True
        traverserMailBoks
    End If
   
    MsgBox "Gennemløb afsluttet"
End Sub
Private Sub traverserMailBoks()
Dim OlApp, Namespace, mailObject, m As Integer, videreSendesTil As String, myForward
    Set OlApp = CreateObject("Outlook.Application")
    Set Namespace = OlApp.GetNamespace("MAPI")
    Set cfold = Namespace.GetDefaultFolder(olFolderInbox)
    antalMails = cfold.Items.Count

    If antalMails > 0 Then
        For m = antalMails To 1 Step -1
            Set mailObject = cfold.Items(m)
            kontonr = Left(mailObject.Subject, 4)          'test
            If IsNumeric(kontonr) = True Then              'test
                videreSendesTil = findVidereSendesTil(kontonr)
                If videreSendesTil <> "" Then
                    Set myForward = mailObject.Forward
                    myForward.Recipients.Add videreSendesTil
                    myForward.Send
                                                                    'hvad skal der ske med mailen efter den er videresendt? Flyttes til undermappe
                    Set arkivMappe = cfold.Folders("MAJ-2015")      'test
                    mailObject.Move arkivMappe
                Else
                    MsgBox "Mailadresse til kontonr.: " & CStr(kontonr) & " kunne ikke findes"
                End If
            End If
        Next m
    End If
End Sub
Private Function findVidereSendesTil(kontonr)
Dim ræk As Integer, antalRæk As Integer
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
    For ræk = 2 To antalRæk
        If kontonr = CStr(Range("A" & ræk)) Then
            findVidereSendesTil = Range("B" & ræk)
            Exit Function
        End If
    Next ræk
   
    findVidereSendesTil = ""
End Function

Super - Det ser ud til at virke perfekt, når jeg tjekker mails i min egen inboks. Den inbox, som jeg skal tjekke er en delt mailbox. Hvordan får jeg sat stien til den?

Fint - så langt så godt

Går du fra at du selv har korrigeret de steder, hvor jeg har kommenteret med 'test. (Glemte at fjerne den numeriske test at kontonr.)

Det du spørger om kan jeg ikke umiddelbart svarer på - men du må jo kunne se det i Outlook.

Ja, det var supergodt tak for hjælpen. Et svar?

Ved du hvordan jeg vælger en fællesmail, istedet for inboksen?

God aften og endnu engang tak for hjælpen :0))

ps. havde ikke set at du havde lagt et svar. Jeg har accepteret det.

Selv tak.
Nej til ? Om fællesmail
Prøv at oprette en tråd vedr. dette

#8 hvor har du accepteret et svar?

Sorry jeg mente at den var afsluttet.

God weekend

Ok - og i lige måde