Macro/VBA kopieren van werkblad naar nieuw bestand, vervolgens locatie bestand mailen

[StefanvdKerkhof]

Goedemiddag,

Ik ben nieuw/onervaren met macro's en VBA binnen excel.
Ik wil onderstaande voor elkaar krijgen dmv een macro en hoop dat hier een expert is die mij kan vertellen of het mogelijk is en hoe ik het voor elkaar kan krijgen

Ik heb een werkbestand waar vanuit diverse andere werkbladen gegevens bij elkaar gezet worden.
Nu wil ik het volgende bereiken via een macro:
- Werkblad kopieren naar een nieuw GEDEELD excel bestand met standaard extensie xlsx naar locatie X met bestandsnaam "Mancolijst Vers & datum van vandaag"
- Het nieuwe bestand moet wel de opmaak krijgen van het originele werkblad maar niet de formules, gegevens moeten als waarden gekopieerd worden.
- Vervolgens een link naar het nieuw aangemaakte bestand versturen via outlook naar een vaste lijst emailadressen.

Misschien is het wel heel makkelijk maar ik kom er niet uit, onderstaande heb ik nu in de macro staan:
- Hij maakt nu een apart bestand aan, maar ik krijg de opmaak er nog niet in.
- Ook geeft hij het nieuwe bestand 2x de (verkeerde) bestandsextensie in de naam mee. (Mancolijst Vers 12-05-2015xlsm.xlsm)
- Hij stuurt vervolgens wel de mail uit, maar de link word als text weergegeven en niet als hyperlink. En ik krijg de extensie er niet bij gezet in de code.

Wie o wie kan me helpen?
Sub opslaan()
'
' opslaan Macro
'

'
Application.DisplayAlerts = False

c00 = "O:\Replenishment\SCM Vers\Mancorapportage Vers\Mancolijst Vers " & Format(Now, "dd-mm-yyyy") & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
c01 = ThisWorkbook.FileFormat

With ThisWorkbook.Sheets.Add
.Range(ThisWorkbook.Sheets("Manco Top 50").UsedRange.Address) = ThisWorkbook.Sheets("Manco Top 50").UsedRange.Value
.Copy

With ActiveWorkbook
.SaveAs c00, c01
.Close False
End With

.Delete
End With

With CreateObject("Outlook.Application").createitem(0)
.to = "emaildres"
.Subject = "Mancolijst vers"
.Body = "O:/Replenishment/SCM_Vers/Mancorapportage_Vers/Mancolijst Vers " & Format(Now, "dd-mm-yyyy")
.Send
End With
End Sub

 

[Elsendoorn2134]

Stefan,

Welkom bij de groep. Een paar dingen.
- Je wilt werken met een bestand waar een macro in staat, en je wil een gedeeld bestand maken.
Aangezien je geen macro's kan hebben in een gedeeld bestand kun je dus geen gebruik maken van het fileformat van je macro bestand.
Als je opgaat slaan gebruik dan:

.SaveAs c00 Fileformat:=xlNormal AccessMode:=xlShared

- Voor de bestandsextentie, laat de "CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)"
gewoon weg, dit wordt opgelost door het fileformat bij opslaan.

- Als je een link wilt versturen zul je hem als een link moeten opnemen en niet als een tekst.
Kijk hier eens hoe je dit kan oplossen.

Veel Succes.

 

[Timshel]

Wat Elsendoorn zegt klopt niet helemaal. Gedeelde bestanden kunnen wel degelijk macro's bevatten. Het is alleen niet mogelijk die macro's te editen zolang het bestand gedeeld is.
Probeer het eens zo:

Sub tsh()
    Application.DisplayAlerts = False
    
    c00 = "O:\Replenishment\SCM Vers\Mancorapportage Vers\Mancolijst Vers " & Format(Now, "dd-mm-yyyy") & ".xlsx"
    ThisWorkbook.Sheets("Manco Top 50").Copy
    ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
    With ActiveWorkbook
        .SaveAs c00, FileFormat:=51, AccessMode:=xlShared
        .Close False
    End With
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = "Opa.Henk@Roffa.nl"
        .Subject = "Een kleinzoon!"
        .HtmlBody = "<a href=""file://" & c00 & """> pica's jewetog <\a>"
        .Display
    End With
    Application.DisplayAlerts = True
End Sub

 

[StefanvdKerkhof]

Super, bedankt voor jullie snelle reacties!

Zowel het opslaan in .xlsx format als de hyperlink naar het nieuwe bestand op de share heb ik nu werkend gekregen.

Nu wil ik alleen nog de opmaak vanuit de originele werkmap kopieren naar het nieuwe bestand, alleen opmaak, formules niet.
Ideeën?

Application.DisplayAlerts = False

    c00 = "O:\Replenishment\SCM Vers\Mancorapportage Vers\Mancolijst Vers " & Format(Now, "dd-mm-yyyy")

    With ThisWorkbook.Sheets.Add
    .Range(ThisWorkbook.Sheets("Manco Top 50").UsedRange.Address) = ThisWorkbook.Sheets("Manco Top 50").UsedRange.Value
    .Copy
    
    With ActiveWorkbook
    .SaveAs c00, FileFormat:=51, accessmode:=xlShared
    
    .Close False
    End With
    
    .Delete
    End With

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strbody = "<HTML><BODY>"
    strbody = strbody & "<A href=O:/Replenishment/SCM%20Vers/Mancorapportage%20Vers/Mancolijst%20Vers%20" & Format(Now, "dd-mm-yyyy") & ".xlsx"">Mancolijst Vers</A>"
    strbody = strbody & "</BODY></HTML>"
    On Error Resume Next
    With OutMail
        .To = "emailadres"
        .Subject = "Mancolijst Vers " & Format(Now, "dd-mm-yyyy")
        .HTMLBody = strbody
        .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

 

[HSV]

In de code van @Timshel is dit al verwerkt.

 

[StefanvdKerkhof]

Ik zie het!
Werkt perfect nu. Nogmaals bedankt voor de hulp!