Excelsheets verzenden als xlsx naar mail in B2

[Charbrug]

Goedemiddag,

Ik weet dat er al vragen over zijn gesteld op deze site, maar ik kan helaas mijn antwoord niet vinden.
Maandelijks importeer ik gegevens in een Excelbestand. Via een macro laat ik alle gegevens automatisch verdelen over diverse tabbladen.
(Per leverancier één sheet, aantal sheets en namen verschillen per keer)

Ik had ook een macro gemaakt voor het verzenden van een sheet in PDF per leverancier.
Helaas wordt een PDF niet geaccepteerd en moet ik als Excelsheet gaan verzenden. tja.. dit werd lastiger.

Ik heb een voorbeeldbestand toegevoegd met de macro's die ik heb gemaakt. Helaas werken deze niet.
(macro van verdelen staat er niet bij, is enkel voorbeeld voor verzenden)

Bekijk bijlage RMA proberen.xlsm

Iemand die mij kan helpen?
Wordt enorm gewaardeerd!

Charlotte

 

[HSV]

Waarom het niet als pdf wordt geaccepteerd is mij onduidelijk, daarom toch een poging met pdf.
Pdf wordt aangemaakt, verzonden per mail als je 'display' in de code veranderd door 'send', verwijderd van Pc.

Bladen 2 en de daarop volgende worden aangemaakt en verzonden.

Sub Mailen()
Dim i As Long
For i = 2 To Sheets.Count
Sheets(i).ExportAsFixedFormat 0, "C:\temp\" & Sheets(i).Range("b2").Value & ".pdf"
    With CreateObject("Outlook.Application").CreateItem(0)
        .to = Sheets(i).Range("b2").Value
        .Subject = "Zomaar iets"
        .Body = "Geachte heer/mevrouw,"  'aanhef
        .Attachments.Add "C:\temp\" & Sheets(i).Range("b2").Value & ".pdf"
        .Display 'or send
        Kill "C:\temp\" & Sheets(i).Range("b2").Value & ".pdf"
    End With
     Next i
End Sub

 

[gast0660]

Beste Charlotte,
Bedoel je dat uw "relaties" geen pdf willen maar een excel sheet?
Indien ja, probeer het volgende eens in uw code.
Verander

 TempFileName = "Part of " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

in bvb

 TempFileName = "Charlotte "

en test

 

[Charbrug]

Goedemorgen,
Ja inderdaad, mijn relaties accepteren helaas geen PDF en willen een Excelsheet.
Ik heb de code aangepast, maar hij pakt hem helaas nog niet..

Hij geeft nu wel een pop-up dat hij gaat verzenden, maar hij verzend niks.

 

[gast0660]

Hoi Charlotte
Deze werkt.
Misschien kan je hier wat inspiratie uithalen.

 

[HSV]

Dan zou dit moeten voldoen.

Sub Mailen()
Dim i As Long
For i = 2 To Sheets.Count
Sheets(i).Copy
 ActiveWorkbook.Sheets(1).SaveAs "c:\temp\" & ThisWorkbook.Sheets(i).Range("b2").Value & ".xlsx", 51
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = ThisWorkbook.Sheets(i).Range("b2").Value
        .Subject = "Zomaar iets"
        .Body = "Geachte heer/mevrouw,"  'aanhef
        .Attachments.Add "C:\temp\" & ThisWorkbook.Sheets(i).Range("b2") & ".xlsx"
        .Display 'or send
        Workbooks(ThisWorkbook.Sheets(i).Range("b2").Value & ".xlsx").Close
        Kill "C:\temp\" & ThisWorkbook.Sheets(i).Range("b2").Value & ".xlsx"
    End With
     Next i
End Sub

 

[Charbrug]

Super Harry! die werkt inderdaad perfect!

Iedereen heel erg bedankt voor het meedenken

 

[HSV]

Graag gedaan.

Voor het aangezicht iets aangepast (hetzelfde resultaat overigens).
Zo zie je beter wat bij elkaar hoort en wat er gebeurt in de code.

Sub Mailen()
Dim i As Long
For i = 2 To Sheets.Count
Sheets(i).Copy
 ActiveWorkbook.Sheets(1).SaveAs "c:\temp\" & ThisWorkbook.Sheets(i).Range("b2").Value & ".xlsx", 51
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = ThisWorkbook.Sheets(i).Range("b2").Value
        .Subject = "Zomaar iets"
        .Body = "Geachte heer/mevrouw,"  'aanhef
        .Attachments.Add "C:\temp\" & ThisWorkbook.Sheets(i).Range("b2") & ".xlsx"
        .Display 'or send
    End With
  Workbooks(ThisWorkbook.Sheets(i).Range("b2").Value & ".xlsx").Close
  Kill "C:\temp\" & ThisWorkbook.Sheets(i).Range("b2").Value & ".xlsx"
Next i
End Sub