Tabbladen los van elkaar mailen

[Spekker]

Hoi allemaal

Ik heb deze vraag eerder gesteld voor een file maar dat was later niet meer van toepassing.
maar nu wel, heb een file met twee tabbladen die los van elkaar naar verschillende mensen moet kunnen worden gemaild. Zelf krijg dit niet voor elkaar en heb daarom jullie hulp nodig.
Op de tabladen heb ik een button gemaakt met daarin de naam maar voor het het tabblad SKM zullen er meerdere personen deze moeten kunnen krijgen.

 

[HSV]

Een algemene code.
Toepasbaar voor elke knop met een kleine aanpassing.

Sub mail()
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveWorkbook.Sheets(1).SaveAs "c:\temp\" & ThisWorkbook.Sheets(1).Name & ".xlsx", 51
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = "naam@provider; naam2@aanbieder"
        .Subject = "Zomaar iets"
        .Body = "Geachte heer/mevrouw,"
        .Attachments.Add "C:\temp\" & ThisWorkbook.Sheets(1).Name & ".xlsx"
        .Display 'or send
    End With
  Workbooks(ThisWorkbook.Sheets(1).Name & ".xlsx").Close
  Kill "C:\temp\" & ThisWorkbook.Sheets(1).Name & ".xlsx"
Application.DisplayAlerts = True
End Sub

Ps. Een bestand plaatsen met wachtwoorden heeft weinig kans op reacties.

 

[Spekker]

Sorry vergeten om het weer ervan af te halen

 

[Spekker]

Gaat nog niet geheel lekker
ik probeer de code aan te passen voor het gebruik maar loop tegen een debug aan

dit is wat ik er nu van heb gemaakt
Sub mail()
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveWorkbook.Sheets(1).SaveAs "S:\Sup_HR\Security\Lijsten\invullijsten portier\Succes en SKM" & ThisWorkbook.Sheets(1).Name & ".xlsx", 51
With CreateObject("Outlook.Application").CreateItem(0)
.To = "naam@provider; Astrid.Kuijt@tateandlyle.com"
.Subject = "Uren overzicht"
.Body = "Geachte heer/mevrouw,"
.Attachments.Add "S:\Sup_HR\Security\Lijsten\invullijsten portier\Succes en SKM" & ThisWorkbook.Sheets(1).Name & ".xlsx"
.send
End With
Workbooks(ThisWorkbook.Sheets(1).Name & ".xlsx").Close
Kill "C:\temp" & ThisWorkbook.Sheets(1).Name & ".xlsx"
Application.DisplayAlerts = True


waar zit mijn fout
ik zal ook de file er bij zetten zonder wachtwoord

 

[HSV]

En het Vba wachtwoord is?

 

[Spekker]

Dacht dat die er ook af was
het is teszil12

 

[HSV]

En waar is de aangepaste mail-code?


En zo'n code als....

Private Sub Workbook_Open()
If IsEmpty(Range("A9")) Then
Sheets("sheet1").Range("A9").Value = Application.UserName
End If


If IsEmpty(Range("A9")) Then
Sheets("sheet1").Range("A9").Value = Date
End If
End Sub

..hoort niet in een standaard module.

Lekker bezig!

 

[Spekker]

Heb die module eruit gehaald, is vermoedelijk blijven zitten vanuit een andere opbouw en deze heb ik er niet uit durven gooien maar nu toch maar gedaan

en dan kom je weer achter dat ik er nog niet veel van weet en dit forum goed kan gebruiken

nu zie ik in de VBA staan dat er een file wordt opgeaslagen maar kan het dan zo zijn dat hij de naam gaat gebruiken het document met de week er van die het is

is dit mogelijk

 

[HSV]

Van het actieve werkblad wordt een kopie gemaakt.
Die wordt tijdelijk opgeslagen in de map 'Temp' die volgens mij op elke Pc staat.
Het maakt overigens niet uit waar het staat, het wordt toch weer verwijderd met 'Kill' in de code.

Sub mail09()
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveWorkbook.Sheets(1).SaveAs "c:\temp\" & ThisWorkbook.Sheets(1).Name & ".xlsx", 51
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = "arie.teeuw@tateandlyle.com"
        .Subject = "Uren overzicht"
        .Body = "Geachte heer/mevrouw,"
        .Attachments.Add "c:\temp\" & ThisWorkbook.Sheets(1).Name & ".xlsx"
        .Display 'or send
         End With
  Workbooks(ThisWorkbook.Sheets(1).Name & ".xlsx").Close
Kill "C:\temp\" & ThisWorkbook.Sheets(1).Name & ".xlsx"
Application.DisplayAlerts = True
End Sub

 

[Spekker]

de code werkt idd wel
alleen nog steeds gaan bij de tabbladen naar de ontvanger en dat is nou net wat ik niet wil
ik wil graag dat er maar 1 blad wordt verstuurd

 

[HSV]

Lees je eigen bericht nog eens over.
Ik kan er geen kaas van maken wat je bedoelt.

Moet 'bij de' misschien 'beide' zijn?

En dan nog wordt er maar één tabblad verzonden in de mail.
Je kan hooguit 'Thisworkbook.sheets(1).name' veranderen in de code naar 'Thisworkbook.Activesheet.name'.

 

[Spekker]

Hoi HVS ik snap wat je bedoeld het staat een beetje vreemd idd.
ik ben nu weer thuis en kan nu eens kijken of ik er weer mee verder kan komen.
moet wel even de code aanpassen zodat ik hier thuis kan uit proberen

 

[HSV]

Het enige wat veranderd moet worden is wat in de laatste regel staat van mijn vorig schrijven.

 

[Spekker]

ja en verander ik die krijg ik een fout melding

dus heb ik nu te veel van die laatste regel weg gehaald ?

 

[HSV]

Teveel weggehaald en het staat er meermaals in.
Klein beetje concentratie kan geen kwaad.

Sub mail09()
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveWorkbook.Sheets(1).SaveAs "c:\temp\" & ThisWorkbook.ActiveSheet.Name & ".xlsx", 51
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = "arie.teeuw@tateandlyle.com"
        .Subject = "Uren overzicht"
        .Body = "Geachte heer/mevrouw,"
        .Attachments.Add "c:\temp\" & ThisWorkbook.ActiveSheet.Name & ".xlsx"
        .Display 'or send
         End With
  Workbooks(ThisWorkbook.ActiveSheet.Name & ".xlsx").Close
Kill "C:\temp\" & ThisWorkbook.ActiveSheet.Name & ".xlsx"
Application.DisplayAlerts = True
End Sub

 

[Spekker]

Heb het nogmaals gekopieerd en nu werkt het wel, weet dat ik soms even langer moet kijken. ik ben blij met je hulp HSV
kan dit morgen gaan proberen of ik het voor elkaar kan krijgen dat hij bij ons op het werk ook gaat werken.
Heb wel in de gaten dat ik dan gewoon een map moet aanmaken met de tekst "temp" want die staat er niet op.
maar dat mag geen probleem zijn

 

[HSV]

Volgens mij staat onderstaand (in het blauw) wel op elke Pc.

Sub mail09()
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveWorkbook.Sheets(1).SaveAs [COLOR=#0000ff]Environ("Temp") [/COLOR]& "\" & ThisWorkbook.ActiveSheet.Name & ".xlsx", 51
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = "naam@provider"
        .Subject = "Uren overzicht"
        .Body = "Geachte heer/mevrouw,"
        .Attachments.Add [COLOR=#0000ff]Environ("Temp")[/COLOR] & "\" & ThisWorkbook.ActiveSheet.Name & ".xlsx"
        .Display 'or send
         End With
  Workbooks(ThisWorkbook.ActiveSheet.Name & ".xlsx").Close
Kill [COLOR=#0000ff]Environ("Temp")[/COLOR] & "\" & ThisWorkbook.ActiveSheet.Name & ".xlsx"
Application.DisplayAlerts = True
End Sub

 

[Spekker]

Ook op een netwerk ?? het gaat om het bedrijf waar ik werkzaam ben en daar zal ik hem op moeten zetten daar ga ik al niet naar een C schijf daar ga ik wel naar een vaste plek waar het staat.
of zeg jij dat ik met die VBA code het gewoon kan doen ??

 

[HSV]

Geen idee, maakt ook niet uit, het bestand wordt weer verwijderd waar ook geplaatst.
Ik dacht meer aan een algemene Pc waar of je je ook bevindt.

 

[snb]

Maak je eerst de basisbegrippen van Excel en VBA eigen voordat je ermee gaat werken.