07. juli 2014 - 15:47Der er
7 kommentarer og 1 løsning
finde alle vedhæftede pdf filer i Outlook
Jeg har følgende koder til at finde alle vedhæftede pdf filer i Outlook
Det er med: If myFolder.Items(A).UnRead = True Then ..... lavet til at søge blandt ulæste mailer Jeg ønsker det ændret til aktivered/highlightet mail
Kan det være noget med If myFolder.Items(A).????? = True Then ..... Kan i hjælpe! -------------------------- Koder------------------
Dim myFolder As Outlook.MAPIFolder Dim myOlApp As Outlook.Application Dim myItem As Outlook.MailItem Dim A As Integer Dim B As Integer Dim strPath As String Dim The_Filename As String
Set myOlApp = CreateObject("Outlook.application") Set myFolder = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) Set myItem = myOlApp.CreateItem(olMailItem)
For A = 1 To myFolder.Items.Count 'If myFolder.Items(A).UnRead = True Then If myFolder.Items(A).Attachments.Count <> 0 Then For B = 1 To myFolder.Items(A).Attachments.Count If UCase(Right(myFolder.Items(A).Attachments(B).DisplayName, 4)) = ".PDF" Then strPath = CurrentProject.Path & "\Documentation" The_Filename = strPath & "\" & myFolder.Items(A).Attachments(B).DisplayName myFolder.Items(A).Attachments(B).SaveAsFile The_Filename
Sub Test() Dim myFolder As Outlook.MAPIFolder Dim myOlApp As Outlook.Application Dim myItem As Outlook.MailItem Dim A As Integer Dim B As Integer Dim strPath As String Dim The_Filename As String
Set myOlApp = CreateObject("Outlook.application") Set myFolder = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set myItem = myOlApp.ActiveExplorer.Selection.Item(1)
If myItem.Attachments.Count <> 0 Then For B = 1 To myItem.Attachments.Count If UCase(Right(myItem.Attachments(B).DisplayName, 4)) = ".PDF" Then strPath = CurrentProject.Path & "\Documentation" The_Filename = strPath & "\" & myItem.Attachments(B).DisplayName myItem.Attachments(B).SaveAsFile The_Filename End If Next End If End Sub
Lige en lille ting: Når der ikke er aktiveret en outlook mail opstår der fejl myItem.Attachments.Count kan ikke vise der ikke er aktiveret noget. Har du en løsning
Yep. Så kan vi lige så godt også tjekke, om Outlook overhovedet er startet (ret selv evt. MsgBox teksterne):
Sub Test() Dim myFolder As Outlook.MAPIFolder Dim myOlApp As Outlook.Application Dim myItem As Outlook.MailItem Dim A As Integer Dim B As Integer Dim strPath As String Dim The_Filename As String Dim ObjOutlook As Object
On Error Resume Next Set ObjOutlook = GetObject(, "Outlook.Application") On Error GoTo 0
If ObjOutlook Is Nothing Then MsgBox "Outlook er ikke startet", vbInformation, "OBS" Exit Sub End If
Set myOlApp = CreateObject("Outlook.application") Set myFolder = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
On Error GoTo ErrorTrap Set myItem = myOlApp.ActiveExplorer.Selection.Item(1) On Error GoTo 0
If myItem.Attachments.Count <> 0 Then For B = 1 To myItem.Attachments.Count If UCase(Right(myItem.Attachments(B).DisplayName, 4)) = ".PDF" Then strPath = CurrentProject.Path & "\Documentation" The_Filename = strPath & "\" & myItem.Attachments(B).DisplayName myItem.Attachments(B).SaveAsFile The_Filename End If Next End If Exit Sub
ErrorTrap: MsgBox "Der er ikke markeret en email", vbInformation, "OBS" Err.Clear On Error GoTo 0 End Sub
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.
