Ergens klopt mijn email macro (VBA) niet...

[Mikevdl]

Hallo

Ik heb een VBA code in gebruik die het bij een druk op de knop de save as opent en na opslaan een email aanmaakt met het excel document als bijlage.
Alleen nu klopt er ergens iets niet en kom er niet helemaal uit...
Als ik de knop in druk komt netjes het opslaan als :love:
Alleen als ik hem opgeslagen heb emailt die niet
Druk ik op annuleren emailt die wel maar emailt die een leeg document

Dit is de code welke ik gebruik:

 

[OctaFish]

Kun je eens beginnen met de code hierboven op te maken zoals het hoort: met de CODE knop?

 

[Mikevdl]

Private Sub CommandButton1_Click()
'INSTELLINGEN VOOR DIALOGS
    xFilter = "Excel Files (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm,"
    xFilterIndex = 1 'NAMELIJK EXCELFILES, ZIE VOLGORDE BIJ FILTER
    
    xFilname = Range("B13") & " Aanmelding bedrijf CMA/Planon "
    OUTPUTBESTAND = Application.GetSaveAsFilename(xFilname, xFilter, xFilterIndex, "Waar moet bestand worden opgeslagen?")
    
    'AFSLUITEN ALS ER GEEN BESTAND IS GESELECTEERD
    If OUTPUTBESTAND = False Then
        MELDING = MsgBox("U heeft het bestand niet opgeslagen, hierdoor zal deze ook niet verzonden worden", vbOKOnly, "")
        
 
    
    


  With CreateObject("Outlook.Application").CreateItem(0)
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = Range("B13") & " Aanmelden voor invoer binnen Planon & CMA "
        .Body = "Bedrijfs naam: " & Range("B13") & Chr(10) & _
                "Bedrijfs adres: " & Range("C14") & Chr(10) & _
                "Telefoonnummer: " & Range("C23") & Chr(10) & _
                "Email adres: " & Range("C25") & Chr(10)
        .Attachments.Add (ThisWorkbook.FullName)
        .display '.SEND of .DISPLAY
    End With
End If

End Sub

 

[Mikevdl]

zo dan

 

[OctaFish]

Ik gebruik zelf een tijdelijk bestand om te mailen. De code is gebaseerd op de code van Ron de Bruin.

Dim FileExtStr As String, TempFilePath As String, TempFileName As String
Dim wb As Workbook
    
    TempFilePath = Environ$("temp") & "\"
    TempFileName = wb.Name & " " & Format(Now, "dd-mmm-yy hhmmss")

    If Val(Application.Version) < 12 Then        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else        'You use Excel 2007-2010
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        .SendMail EmailDefault, "Planning + Werkuren van " & Environ("Username")
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

Werkt prima.

 

[Mikevdl]

Ik ga hem even proberen....zo teug

 

[Mikevdl]

Hoi Octafish,

Welk bestandsnaam moet ik de temp mee geven, heb jou code 1 op 1 gekopieerd (niet snugger van mij) want hij houd jou benaming aan...heb het bestand (graag met discretie gebruiken) bijgevoegd...de bedoeling is dat die de naam van het bestand haalt uit bedrijfsnaam en een vastgestelde tekst "aanmaken bedrijf planon/cma"...

ik heb het bestand bijgevoegd...

 

[snb]

Je hebt onvoldoende gespecificeerd waar de gegevens staan.

Sub tst()
    If ThisWorkbook.Path = "" Then ThisWorkbook.SaveAs Environ("temp") & "attach.xlsx"
    
    sn = ThisWorkbook.Sheets("sheet1").Range("A1:C25")
    
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = "aaa@emailadres.nl"
        .Subject = sn(13, 2) & " Aanmelden voor invoer binnen Planon & CMA "
        .Body = "Bedrijfs naam: " & sn(13, 2) & Chr(10) & _
                "Bedrijfs adres: " & sn(14, 3) & Chr(10) & _
                "Telefoonnummer: " & sn(23, 3) & Chr(10) & _
                "Email adres: " & sn(25, 3) & Chr(10)
        .Attachments.Add Environ("temp") & "attach.xlsx"
        .send
    End With
End Sub

 

[Mikevdl]

bedankt allen ben een stuk verder nu ik ga hier mee puzzelen moet even het 1 en ander aanpassen naar 2003 maar komt goed