Bijlage opslaan outlook

Status
Niet open voor verdere reacties.
V

Vexcel

Gebruiker
Lid geworden
3 mei 2015
Berichten
63
Lezer,
Eerder is een vraag gesteld over opslaan van bijlage in e-mail Outlook (https://www.helpmij.nl/forum/showthread.php/923197-Bijlagen-opslaan) Een soortgelijk VBA heb ik van internet geplukt. Ik pak het element waar het om gaat.

Code: 
Dim lngCount As Long

.
.
.
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
.
.
   If lngCount > 0 Then
 
        ' We need to use a count down loop for removing items
        ' from a collection. Otherwise, the loop counter gets
        ' confused and only every other item is removed.
 
        For i = lngCount To 1 Step -1
 
            ' Save attachment before deleting from item.
            ' Get the file name.
            strFile = objAttachments.Item(i).FileName
 
            ' Combine with the path to the Temp folder.
            strFile = strFolderpath & strFile
 
            ' Save the attachment as a file.
            objAttachments.Item(i).SaveAsFile strFile

Als ik een e-mail open met 1 bijlage dan zou lngCount op 1 moeten staan. Echter komt het onverwachts voor dat de waarde hoger staat. Dit is nogzal wispelturig. Ook aflsuiten Outlook en opnieuw starten bood geen oplossing. Het lijkt wel of er iets in memory blijft hangen. Bij het eerste doorlopen van For Next loop wordt het juiste bestand weg geschreven en bij de volgende loops wordt een bestand wegschreven die niet gelezen kan worden. Na veel zoekwerk, en de oorzaak niet gevonden, werkt dezelfde mail nu wel juist en ziet die dat de waarde 1 is. Enige suggestie waardoor dit kan komen? Daaarnaast zoek ik naar de mogelijkheid dat alleen een specifiek xlsx bestand opgeslagen wordt en geen andersoortige file extenties. Tot slot, hoe kan er gecontrolleerd worden dat als er meer xlsx bestanden toegevoegd zijn, eerst een melding verschijnt met de vraag om keuze van het bestand, bijvoorbeeld 1ste of 3de bijlage? Het mag duidelijk zijn dat mijn kennis VBA Outlook beperkt is.

Met vriendelijke groet,
 
Laatst bewerkt:
Gebruik dit eens:
Code: 
[COLOR="#008000"]' Save the attachment as a file.[/COLOR]
If Right(strFile, 5) = ".xlsx" Then
    objAttachments.Item(i).SaveAsFile strFile
End If

Tevens, gebruik codetags bij het plaatsen van code.
 
Laatst bewerkt:
Ed,
Dank je wel, dit ga ik proberen. De oplossing lijkt zo simpel, maar je moet er maar op komen. Het ophogen van de waarde in "lngCount" lijkt te komen doordat eerder een mail met hetzelfde onderwerp en bijlage gezonden is. Ik kwam daar bij toeval achter. Bij de eerste probleemloos, bij de 2de mail staat de waarde op 2 en werkt het niet meer om de file te open en loopt eea stuk. Iemnd suggesties hoe dit te ondervangen valt?
 
Het is niet nodig om lngCount hoog te laten beginnen omdat je niets verwijderd.
Doe het zo:
Code: 
For i 1 To objAttachments.Count
Dan heb je lngCount helemaal niet nodig.
Misschien dat dat helpt.
 
Laatst bewerkt:
Ed,
Je tip van "If Right(strFile, 5) = ".xlsx" Then" heb ik verwerkt en dit werkt. Je laatst optie van "For i 1 To objAttachments.Count" blijft toch 2 x te doorlopen te wporden terwijl i de waarde 1 heeft. Dit is dan ook bij zo'n voorbeeld waarin de mail 2 x voorkomt en de laatst binnen gekomen mail dit probleem geeft. Na "Next i" wordt terug gesprongen naar: " strFile = ObjAttachement.Item(i).fileName. Daarna wordt er een bestand weggeshreven die niet geopend kan worden.

Code: 
'
' Save Attachment from e-mail into "C:\Temp\" with filename: "IDU.xlsx"
'
Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
 
    ' Get the path to your My Documents folder in your personal (U:) environment
'    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
'    On Error Resume Next
 
    ' Instantiate an Outlook Application object.
    Set objOL = Application
 
    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection
   
 
' The attachment folder needs to exist
' You can change this to another folder name of your choice
 
    ' Set the Attachment folder.
    strFolderpath = "c:\temp\"
 
    ' Check each selected item for attachments.
    For Each objMsg In objSelection
 
    Set objAttachments = objMsg.Attachments
    
'    lngCount = objAttachments.Count
'
'    If lngCount > 0 Then
    
    ' Use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.
    
'    For i = lngCount To 1 Step -1
    For i = 1 To objAttachments.Count
        
    ' Get the file name.
    strFile = objAttachments.Item(i).fileName
    
    If Right(strFile, 5) <> ".xlsx" Then
        MsgBox "Dit is geen Excel (IDU) bestand!", vbExclamation, "Check op Excel bestand."
        Exit Sub
    End If
        
    strFile = "IDU.xlsx"
    
    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile
    
    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile
       
    Next i
'    End If
    
    Next
    
ExitSub:
 
Hou er rekening mee dat niet alleen een zichtbare bijlage wordt getelt.
Ook plaatjes in de mail worden als bijlage gezien.

Je code doet het hier overigens prima.
 
Laatst bewerkt:
Ed,
Eea is even op de achtergrond geraakt, daarom is een reactie uitgebleven. Er worden handtekeningen ook regelmatig afbeeldingen opgenomen zoals van merken, bedrijven of een foto van betrokkene. Worden ook deze meegeteld in het aantal bijlages? Zo ja, bestaat er dan ook een mogelijkheid om dit in de body uit te sluiten? Het document, waarvoor de opslag bedoelt is, is als bijlage toegevoegd aan een HTML formatted e-mail.

Greetings
 
Ja, die worden ook als bijlage geteld.
Maar je kan toch gewoon alleen de bijlagen met extensie .xlsx verwerken?
 
Ed,
Het gedrag van de macro lijkt nog al wispelturig. Soms zegt die er geen xlsx gekoppeld is terwijl dit wel het geval is. Ik had de regels er dan ook uit geremarkt. Ook de bijlage in de mail die als enige bekend is wordt soms vreemd op gereageerd. in variabele "lngCount " staat dan de waarde 3. En dit terwijl het een unieke mail is met 1 xlsx bijlage. De remarks weer verwijderd en nu werkt het weer. Ik kan mijn vinger gewoon niet op de pijnplek leggen. Heel vervelend. Het oplossen op het forum wordt dan ook een probleem lijkt mij. ALs je nog sugesties hebt graag. Ik moet anders deze vraag maar afsluiten. Bedankt zo ver voor je inspanningen.
 
Test deze eens:
Code: 
Public Sub SaveAttachments()
    Dim objOL As Outlook.Application
    Dim objMsg As Object
    Dim objAttachments As Outlook.Attachments
    
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim Gevonden As Integer
     
    Set objOL = Application
       
    For Each objMsg In objOL.ActiveExplorer.Selection
        Set objAttachments = objMsg.Attachments
        For i = 1 To objAttachments.Count
            strFile = objAttachments.Item(i).FileName
            If Right(strFile, 5) = ".xlsx" Then
                Gevonden = Gevonden + 1
                strFile = "C:\temp\IDU_" & Gevonden & ".xlsx"
                objAttachments.Item(i).SaveAsFile strFile
            End If
        Next i
    Next objMsg
    
    If Gevonden = 0 Then
        MsgBox "Geen .xlsx bijlagen aangetroffen.", vbInformation + vbOKOnly, "Geen xlsx"
    End If
End Sub
 
Ed,
Je script geeft wel meer duidelijkheid. Er worden inderdaad images geteld door objAttachementCount. De loop wordt dan ook dat aantal keren doorlopen. Te zien valt dat de bijlage gekozen wordt maar dat er ook image001.jpg gezien wordt. Eea loopt daar dan ook op stuk. bij objAttachement.item(i).SaveAsFiel strFile. (i) heeft daarbij de waarde 2 ipv 1.
 
Hij werkt bij mij prima.
En stuklopen op een jpg kan niet want daar doet hij helemaal niets mee.
Hij doet alleen wat als er een .xlsx bijlage werd gevonden.
 
Ed,
Na "objAttachments.Item(i).SaveAsFile strFile" en voor "End If" heb ik "Exit For" geplaatst en nu werkt het goed. Verder heb ik na de MsgBox "Exit Sub" opgenomen. Als er een <> xlsx file werd gevonden liep deze verder in de VBA script en was een foutmelding het gevolg. Alles lijkt nu naar behoren te werken. Dank je wel voor je support.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan