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