Lege bijlage wanneer verzonden via macro

[abracadaver909]

Beste Helpmij-ers,

Ik heb een excel-bestand met op een sheet een knop met macro. Deze macro verzend het hele werkboek naar de personen waarvan hun e-mailadres in een kolom staan. Dit werkt allemaal prima, maar nu komt het:

Als het bestand via deze knop verstuurd wordt, ontvang ik een leeg excel-bestand op mijn android telefoon (samsung galaxy S3). Dit is niet het geval als ik op mijn pc inlog in mijn mailaccount.
Verder als het bestand op de "reguliere" manier (dus als bijlage in mijn mailaccount) wordt verstuurd, dan ontvang ik wel het volledige bestand op mijn telefoon.

Voor de zekerheid heb ik hier het stukje macro wat de verzending verzorgd:

Sub Verstuur()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strto As String
                
    Application.ScreenUpdating = False
        
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    For Each cell In ThisWorkbook.Sheets("Namen").Range("C3:C29").Cells.SpecialCells(xlCellTypeConstants)
        
        If cell.Value Like "?*@?*.?*" Then
               
        strto = strto & cell.Value & "; "
        End If
   
    Next cell

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next

            With OutMail
                .To = strto
                .Subject = "Snipperboek"
                .Attachments.Add ActiveWorkbook.FullName
                .Send  'Or use Display
            End With

            On Error GoTo 0
            Set OutMail = Nothing
    
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    
End Sub

Heeft iemand enig idee hoe dat kan en/of hoe ik dat kan oplossen?

Bij voorbaat dank,
Chris

 

[edmoor]

Die OnError Resume Next zorgt ervoor dat je helemaal niks ziet als er iets mis gaat.
Haal die regel er eens uit en kijk of je dan een foutmelding van de With Outmail krijgt.

 

[abracadaver909]

Dank je voor het snelle respons.
Ik zal thuis eerst even outlook moeten installeren (is elders getest) en als de error zich voordoet, zal ik die meteen hier posten.

 

[abracadaver909]

Ik heb de OnError uit gecomment, maar ik kreeg geen error melding.

Sterker nog, hij deed eigenlijk precies hetzelfde als voorheen. Het probleem ligt volgens mij in de combinatie van macro's met android, want als hierboven vermeld is er geen probleem als het als reguliere bijlage wordt verstuurd.
Aaaaaargh, ik word gek!

 

[abracadaver909]

Ik ben eruit.
De Oplossing:

Sub Mail_workbook_Outlook_2()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object

    Set wb1 = ActiveWorkbook
    If Val(Application.Version) >= 12 Then
        If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
            Exit Sub
        End If
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Make a copy of the file.
    ' If you want to change the file name then change only TempFileName variable.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    FileExtStr = "." & LCase(Right(wb1.Name, _
                                   Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

    Set OutApp = CreateObject("Outlook.Application")
    
    'On Error GoTo cleanup
    For Each cell In ThisWorkbook.Sheets("Namen").Range("C3:C29").Cells.SpecialCells(xlCellTypeConstants)
        
        If cell.Value Like "?*@?*.?*" Then
               
        strto = strto & cell.Value & "; "
        End If
   
    Next cell

    
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run this procedure.
    With OutMail
        .To = strto
        .CC = ""
        .BCC = ""
        .Subject = "Snipperboek"
        .Body = ""
        .Attachments.Add wb2.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .Send
    End With
    On Error GoTo 0

    wb2.Close SaveChanges:=False

    ' Delete the file.
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Het had waarschijnlijk te maken met het tijdelijk opslaan van het bestand. Dat deze deze macro nu wel :thumb:

 

[edmoor]

Well done! :thumb: