Avatar billede morten_aire Nybegynder
14. april 2008 - 09:01 Der er 1 kommentar

VBA outlook. binær kørsel og mystisk adfærd.

Goddag, jeg har 3 spørgsmål:

Binær kørsel>
Det lader til at naar jeg kører makroen så tager den halvdelen hver kørsel og efterlader den anden halvdel.
Et svar der fører til en løsning af dette problem giver 100point da den er ret kritisk for hvordan jeg gerne ville have det til at køre.

Mærkelig opførsel>
Jeg Bruger kommandoen 'RmDir ("min/mappe")' men det sker bare ikke, ved næste kørsel siger den siger den at jeg ikke har adgang til at oprette den mappe.
Bruger jeg den samme kommando i en seperat makro kører den det fint.
Denne giver 30point, ikke fordi jeg ikke meget gerne vil have det løst, men jeg forestiller mig at det ikke er videre avanceret at løse.

Overload>
Det lader til at naar jeg kører kommandoen, og programmet udfører en handling imens(modtager mail fx.) går den i stå
50 point til hvordan jeg kan undgå dette.

Min kode går ud fra at den skal finde den rigtige inbox(ikke standart).
Plukke alle pdf filer ud af de mails der ligger I den indbakke og gemme dem i en midlertidig mappe.
sende alle de mails der får plukket pdfer ud af sig et sted, dem der starter med en bestemt tekst et andet sted.
flage dem med rød der ikke hører under de 2 grupper
sende mail med alle de pdf filer der er plukket ud.
slette mappen og de filer der er i.
håber ikke at min censur besværliggør fejlfinding.

Dim Item As Object
Dim Atmt As Outlook.Attachment
Dim AtmtC, LocPdfC, PauseTime, Start As Integer
 
Sub NewPdfMail()
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Addr1 = "navn@addres.se"
Addr2 = "navn@addres.se"
Const MailReciever As String = "en@mail.dk"
strPdfPath = "Min\Tempmappe\"

For Each Fold In GetNamespace("MAPI").Folders
    If Fold.Name = "Postkasse - ikkestandartfolder" Then
        For Each Folds In Fold.Folders
            If Folds.Name = "Inbox" Then
                Set Inbox = Folds
            End If
        Next
    End If
Next
For Each Rec In GetNamespace("MAPI").Folders
    If Rec.Name = "Postkasse - ikkestandartfolder" Then
        For Each Recs In Rec.Folders
            If Recs.Name = "ikke standartfolder" Then
                Set A = Recs
            End If
        Next
    End If
Next
For Each Sen In GetNamespace("MAPI").Folders
    If Sen.Name = "Postkasse - ikkestandartfolder" Then
        For Each Sens In Sen.Folders
            If Sens.Name = "ikke standartfolder" Then
                Set B = Sens
            End If
        Next
    End If
Next

If Inbox.Items.Count = 0 Then
    Exit Sub
End If

MkDir ("min\Tempmappe")
Dim NyMail As Outlook.MailItem
Set NyMail = olApp.CreateItem(olMailItem)
NyMail.To = MailReciever
NyMail.Subject = "en text" & Date & Time
For Each Item In Inbox.Items
    If Item.FlagStatus <> olFlagMarked Then
        If Left(Item.Subject, 7) = "text" Then
            Item.Move (B)
            Set Item = Nothing
        ElseIf Item.FlagStatus <> olFlagMarked & Item.SenderEmailAddress <> Addr1 & Item.SenderEmailAddress <> Addr2 Then
            AtmtC = Item.Attachments.Count
            If AtmtC <> 0 Then
                LocPdfC = 0
                For Each Atmt In Item.Attachments
                    If Right(Atmt.FileName, 3) = "pdf" Or Right(Atmt.FileName, 3) = "PDF" Then
                        On Error Resume Next
                        LocPdfC = LocPdfC + 1
                    End If
                Next
            End If
            If LocPdfC <> 0 Then
                For Each Atmt In Item.Attachments
                    If Right(Atmt.FileName, 3) = "pdf" Or Right(Atmt.FileName, 3) = "PDF" Then
                        FileName = strPdfPath & Atmt.FileName
                        Atmt.SaveAsFile FileName
                        NyMail.Attachments.Add (FileName)
                    End If
                Next
            End If
            Item.Move (B)
            Set Item = Nothing
        Else
            Item.FlagStatus = olFlagMarked
            Item.Save
        End If
    End If
Next

If LocPdfC > 0 Then
    Set Item = Nothing
    NyMail.Send
    On Error GoTo 0
End If

Set objOL = Nothing
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing

If Dir("min\Tempmappe\*") <> "" Then
    Kill ("min\Tempmappe\*")
End If

RmDir ("min\Tempmappe")

End Sub
Avatar billede morten_aire Nybegynder
16. april 2008 - 13:14 #1
bump :) leder stadig efter en løsning til disse problemer.
Husk du må *meget* gerne svare selvom du kun kan svare på en a tingende
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester