Hjælp til en menu/funktion til arkivering af mail

som macro

Her er et bud - prøv at se på dette:
Sub ArkiverMail()
Dim mailApp, Namespace, indbakke, m, arkivMappe
    arkivMappe = "D:\Eksperten\Mails\"                'Indsæt aktuelle mappe
   
    Set mailApp = CreateObject("Outlook.Application")
    Set Namespace = mailApp.GetNamespace("MAPI")
    Set indbakke = Namespace.GetDefaultFolder(olFolderInbox)
             
    If indbakke.Items.Count > 0 Then
        For m = 1 To indbakke.Items.Count
            If InStr(LCase(indbakke.Items(m).BillingInformation), "<arkiveret>") = 0 Then
                indbakke.Items(m).SaveAs arkivMappe + indbakke.Items(m).Subject + ".msg", olMSG
                indbakke.Items(m).BillingInformation = "<arkiveret>"
                indbakke.Items(m).Save
            End If
        Next m
    End If
End Sub

Har ikke fået markering af mails til at fungere - men der er alternative muligheder - evt. en prompt?

supertekst>>

se lige denne
'Dim myOlApp As New Outlook.Application
    'Dim myOlExp As Outlook.Explorer
    'Dim myOlSel As Outlook.Selection
    'Dim objItem As Object
    'Dim MsgTxt, fileName As String
    'Dim x As Integer
   
    'Dim fp As FileDialog
    'Set fp = FileDialog(msoFileDialogFilePicker)
    'her = fp
   
    'MsgTxt = "You have selected items from: "
   
    'Set myOlExp = myOlApp.ActiveExplorer
    'Set myOlSel = myOlExp.Selection
   
    'For x = 1 To myOlSel.Count
    '    MsgTxt = MsgTxt & myOlSel.Item(x).Subject & ";"
    'Set objItem = myOlSel.Item(x)
    'fileName = myOlSel.Item(x).To & " - " & myOlSel.Item(x).Subject
   
    'objItem.SaveAs "c:\test\" & fileName & ".msg", olMSG
       
    'Next x

jeg sidder lige og roder med en filedialog så man selv kan vælge hvor de skal gemmes, men kan sgu ikke få det til at funge

og så er der et andet lille problem hvis der er : i subject virker det ikke 100% korrekt
Men det må kunne løses

ups sorry ser lige at alt er remmet ud :-D skulle jo lige teste dit forslag

Ja - illegale tegn kan løses - prøv at de denne funktion:
Private Function testOkTegn(mn)
Dim illegaletegn As String, Navn As String
    illegaletegn = "\/:*?<>|" + Chr(34)
    Navn = ""
   
    For f = 1 To Len(mn)
        If InStr(illegaletegn, Mid(mn, f, 1)) > 0 Then
            Navn = Navn + "_"
        Else
            Navn = Navn + Mid(mn, f, 1)
        End If
    Next f
    testOkTegn = Navn
End Function

hvordan implemterer du så det kun er det der er selected der "køres"

hvor skal den funktion sættes ind

øh never mind det er jo windows eget fs der forhinderer

Den er implementeret

kan denne ikke bruges i outlook
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

okay det kan den så ikke, men er der en der kan en anden måde
Følgende virker  (men lidt skodagtigt)
Public Sub vis()
Set oOffice = CreateObject("Word.Application")
Set fd = oOffice.FileDialog(msoFileDialogFolderPicker)
iShowRetturn = fd.Show
sPath = fd.InitialFileName
MsgBox sPath
Set fd = Nothing
Set oOffice = Nothing
End Sub

Virkelig ikke nogen der kan omgå sådan en lille detalje, hmm.

Jeg overvejer at lave min egen lille dll i .net og bruge den dialog der følger med der, den ville løse opgave 100%

smid et svar super>> tusind tak for hjælpen

Selv tak!