Opgelost XLSM bestand verzenden/mailen als XLSX bestand

Dit topic is als opgelost gemarkeerd
Status
Niet open voor verdere reacties.
T

Tinusk1964

Gebruiker
Lid geworden
12 feb 2025
Berichten
9
Het werkbestand wordt ingevuld en bewerkt als XLSM bestand.
Er is een knop/macro die het bestand verzend naar specifiek mailadres.
Nu heeft de ontvanger aangegeven graag XLSX bestand te willen ontvangen.
Dus de huidige code zou aangepast moeten worden zodat het bestand "tijdelijk" wordt geconverteerd naar xlsx, en daarna verzonden als bijlage. waarna het tijdelijke bestand weer wordt verwijderd.
Of een andere oplossing waarbij er geen tijdelijk bestand noodzakelijk is.
De nieuwe naam met extensie wordt al gegenereerd in cel C4 (incl extensie xlsx).
Hierbij de huidige code die nu werkt.
Weet iemand een oplossing om een werkend macro te krijgen?


Code: 
Private Sub CommandButton3_Click()
    Dim OutApp As Object
    Dim OutMail As Object
    
    If Not ActiveWorkbook.Saved Then
        If ActiveWorkbook.Path = "" Then
            MsgBox "Het document is nog niet opgeslagen.", vbCritical, "Mailen document"
            Exit Sub
        End If
        
        If MsgBox("De wijzigingen zijn nog niet opgeslagen. Doorgaan?", vbYesNo + vbCritical, "Mailen document") = vbNo Then
            Exit Sub
        End If
    End If
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "vluvero@rws.nl"
        .CC = ""
        .BCC = ""
        .Subject = Sheets("Invulblad").Range("V4").Value
        .Body = "Vluchtrapportage"
        .Attachments.Add ActiveWorkbook.FullName
        .Display
    End With
End Sub
 
Laatst bewerkt:
Dat kan bijvoorbeeld zo:
Code: 
Private Sub CommandButton5_Click()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim tmpwb As String
   
    If Not ActiveWorkbook.Saved Then
        If ActiveWorkbook.Path = "" Then
            MsgBox "Het document is nog niet opgeslagen.", vbCritical, "Mailen document"
            Exit Sub
        End If
    End If
   
    tmpwb = Environ("Temp") & Replace(ThisWorkbook.Name, ".xlsm", ".xlsx")
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ThisWorkbook.SaveCopyAs Environ("Temp") & ThisWorkbook.Name
    Workbooks.Open Environ("Temp") & ThisWorkbook.Name
    ActiveWorkbook.SaveAs tmpwb, 51
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "12345@678s.nl"
        .CC = ""
        .BCC = ""
        .Subject = Sheets("Invulblad").Range("V4").Value
        .Body = "Rapportage"
        .Attachments.Add tmpwb
        .Display
    End With
    Kill tmpwb
End Sub
 
Ik zie net dat het niet helemaal goed is, al heb je er geen last van.
Code: 
Environ("Temp") & ThisWorkbook.Name
Moet zijn:
Code: 
Environ("Temp") & "\" & ThisWorkbook.Name
 
Sorry maar toch nog een klein probleempje, de bijlage wordt nu hernoemd met TEMP ervoor. "Tempflightadmin" bijvoorbeeld.
Ik heb het pas deze week kunnen testen op een andere locatie, vandaar de late reactie.
Hieronder de huidige code:

Code: 
Private Sub CommandButton3_Click()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim tmpwb As String
  
    If Not ActiveWorkbook.Saved Then
        If ActiveWorkbook.Path = "" Then
            MsgBox "Het document is nog niet opgeslagen.", vbCritical, "Mailen document"
            Exit Sub
        End If
    End If
  
    tmpwb = Environ("Temp") & Replace(ThisWorkbook.Name, ".xlsm", ".xlsx")
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ThisWorkbook.SaveCopyAs Environ("Temp") & ThisWorkbook.Name
    Workbooks.Open Environ("Temp") & ThisWorkbook.Name
    ActiveWorkbook.SaveAs tmpwb, 51
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
  
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "123456@789.nl"
        .CC = ""
        .BCC = ""
        .Subject = Sheets("Invulblad").Range("V4").Value
        .Body = "Vlucht Rapportage"
        .Attachments.Add tmpwb
        .Display
    End With
    Kill tmpwb
End Sub
 
Zie #4.
Wijzig:
Code: 
Environ("Temp")
In:
Code: 
Environ("Temp") & "\"
 
Als ik die wijziging doorvoer, loopt excel vast en krijg ik alleen de macro knop te zien!

Code: 
Private Sub CommandButton3_Click()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim tmpwb As String
  
    If Not ActiveWorkbook.Saved Then
        If ActiveWorkbook.Path = "" Then
            MsgBox "Het document is nog niet opgeslagen.", vbCritical, "Mailen document"
            Exit Sub
        End If
    End If
  
    tmpwb = Environ("Temp") & "\" & Replace(ThisWorkbook.Name, ".xlsm", ".xlsx")
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ThisWorkbook.SaveCopyAs Environ("Temp") & "\" & ThisWorkbook.Name
    Workbooks.Open Environ("Temp") & "\" & ThisWorkbook.Name
    ActiveWorkbook.SaveAs tmpwb, 51
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
  
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "12345@6789.nl"
        .CC = ""
        .BCC = ""
        .Subject = Sheets("Invulblad").Range("V4").Value
        .Body = "Vlucht Rapportage"
        .Attachments.Add tmpwb
        .Display
    End With
    Kill tmpwb
End Sub
 
Plaats dan je document.
En wat bedoel je met "loopt vast"?
 
Sorry, maar daar zit me iets te veel vertrouwelijke informatie in. Maar bedankt ben zeker een stuk verder geholpen.
 
Is dit niet voldoende?
Code: 
Sub hsv()
Dim tmpwb As String
ThisWorkbook.Sheets.Copy
tmpwb = Environ("temp") & "\testje.xlsx"
  With ActiveWorkbook
    .SaveAs tmpwb, 51
    .Close
  End With
  With CreateObject("Outlook.Application").CreateItem(0)
        .To = "12345@6789.nl"
        .CC = ""
        .BCC = ""
        .Subject = Sheets("Invulblad").Range("V4").Value
        .Body = "Vlucht Rapportage"
        .Attachments.Add tmpwb
        .Display
    End With
  Kill tmpwb
End Sub
 
Ik denk het wel :)
 
  • Leuk
Waarderingen: HSV
Ach, je kan dit stukje nog veranderen indien je het niet eens bent met de bestandsnaam "testje.xlsx".
Code: 
tmpwb = Environ("temp") & "\" & Split(ThisWorkbook.Name, ".")(0) & ".xlsx"
 
HSV, bedankt maar krijg dan melding of met of zonder macro`s wil opslaan . De code van edmoor werkt beter alleen de naam van de bijlage is niet correct. Zie afbeelding.
Als ik & "\" toevoeg in de 3 regels krijg ik een wit scherm in excel, met alleen de macro knop zichtbaar.
Ga er morgen wel verder mee, alvast bedankt voor de adviezen.

Knipsel.JPG
 
In de code van HSV kan je net voor het opslaan deze regel invoegen:
Code: 
Application.DisplayAlerts = False
Dan krijg je die melding niet.
Daarna weer op True zetten.
 
Het zal, maar ik kan me er niets bij voorstellen.
De 51 in de code voorkomt dat het anders wordt opgeslagen dan alleen een .xlsx bestand.
Code: 
.SaveAs tmpwb, 51
 
Omdat Testje.xlsx gemaakt wordt vanuit een .xlsm document gaat Excel er vanuit dat de copy ook een xlsm moet zijn.
Vandaar dat je die vraag krijgt, dat is mijn perceptie.
Door DisplayAlerts op False te zetten voorkom je de vraag.
 
Uiteraard, dat is mij bekend door die regel in te voegen.
Maar hier krijg ik die melding niet.
 
Dan is dat wellicht anders in jouw Office versie.
 
Het werkt, perfect.
Dit is de uiteindelijke code geworden. Bedankt voor alle adviezen.

Code: 
Private Sub CommandButton3_Click()
    
    Dim tmpwb As String
    
ThisWorkbook.Sheets.Copy
    tmpwb = Environ("temp") & "\" & Split(ThisWorkbook.Name, ".")(0) & (".xlsx")
    With ActiveWorkbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ActiveWorkbook.SaveAs tmpwb, 51
    ActiveWorkbook.Close
  End With
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = "12345@6789.nl"
        .CC = ""
        .BCC = ""
        .Subject = Sheets("Invulblad").Range("V4").Value
        .Body = "Vlucht Rapportage"
        .Attachments.Add tmpwb
        .Display
    End With
  Kill tmpwb
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan