• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

opslaan met als naam wat er in combobox 1 staat.

Status
Niet open voor verdere reacties.

davylenders123

Gebruiker
Lid geworden
20 jun 2010
Berichten
902
Deze code hieronder slaat het bestand op en mailt het.

Er zitten in het werkblad combo boxen verwerkt.
Is het moggelijk om het bestand op te slaan met als naam wat er in combobox 1 staat.
Het werkblad waar de combo box instaat noemt "controle"

Nu slaat het op met als naam "Controle aanvraag doorgestuurd op dd-mm-yyyy hh & "u " & "mm "

Dit zou moeten worden Controle aanvraag "wat in combobox 1 staat" gevolgd door de datum en uur van doorsturen.

Wat moet er dan aan de code worden gewijzigd ?

Het stukje code dat opslaat heb ik in het rood gezet.



Code:
Const EMBED_ATTACHMENT As Long = 1454
Const vaCopyTo As Variant = "" 'copy mailen naar: "adres"

Sub mail()


 Dim vaRecipients As Variant
  Dim noSession As Object
  Dim noDatabase As Object
  Dim noDocument As Object
  Dim noEmbedObject As Object
  Dim noAttachment As Object


If vbNo = MsgBox("Ben je wel zeker dat je die mail wil verzenden", vbYesNo) Then Exit Sub
If vbNo = MsgBox("Heb je lotus notus open staan?", vbYesNo) Then Exit Sub

Application.DisplayAlerts = False
Sheets("adres").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("dokter").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("postcodes").Select
    ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True


    
    ActiveSheet.Unprotect Password:="1230"
    Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("E11").Select
    ActiveSheet.Protect Password:="1230", DrawingObjects:=True, Contents:=True, Scenarios:=True
    
   



        
 With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        .DeleteLines 1, .CountOfLines
End With
Sheets("Controle").ComboBox1.Enabled = False
Sheets("Controle").ComboBox2.Enabled = False
Sheets("Controle").ComboBox3.Enabled = False
Sheets("Controle").ComboBox4.Enabled = False
Sheets("Controle").ComboBox5.Enabled = False
Sheets("Controle").ComboBox6.Enabled = False
Sheets("Controle").ComboBox7.Enabled = False
Sheets("Controle").ComboBox8.Enabled = False

Application.EnableEvents = False

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="1230"
Application.EnableEvents = True





ActiveSheet.Unprotect Password:="1230"
    ActiveSheet.Shapes("Button 13").Select
    Selection.Delete
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
        
       
     [COLOR="red"]  ActiveWorkbook.SaveAs Filename:=("T:\Mag-Data\Mit pc\davy\Mensura Controle\controle al doorgemaild" & "\Controle aanvraag   " & Sheets("controle").Cells(1, 14).Value & " Doorgestuurd op " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls")
stpath = "T:\Mag-Data\Mit pc\davy\Mensura Controle\controle al doorgemaild" 'locactie waar bijlage staat
stsubject = "Controle aanvraag   " & Sheets("controle").Cells(1, 14).Value & " Doorgestuurd op  " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls" _[/COLOR] 
      

vamsg = "Goedemorgen, " & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
" Bij deze stuur ik u een controle aanvraag voor een werknemer van ons." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
"Dit zit in een excel file die jullie kunnen afdrukken als jullie willen. " & vbCrLf & vbCrLf & _
"Het verslag van de controle arts mag naar het volgende mail adres gestuurd worden. " & vbCrLf & vbCrLf & _
" Dhjhj@jhy.be" & vbCrLf & vbCrLf & _
" " & vbCrLf & vbCrLf & _
      "Met Vriendelijke Groeten" & vbCrLf & vbCrLf & _
      "De Hoofdmagazijniers"


'mailbody voorzien van gegevens
stfilename = "Dagstaat Magazijniers .xls" 'Bestandsnaam
stattachment = ("T:\Mag-Data\Mit pc\davy\Mensura Controle\controle al doorgemaild" & "\Controle aanvraag   " & Sheets("controle").Cells(1, 14).Value & " Doorgestuurd op " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls")
vaRecipients = VBA.Array("gh@hotmail.com", "hjuy@kjf.be") 'mailadressen("eerste ontvanger" , "tweede ontvanger", enz.)

                  'Bepaal de Lotus Notes COM's Objecten.
                  Set noSession = CreateObject("Notes.NotesSession")
                  Set noDatabase = noSession.GETDATABASE("", "")
                  
                  'Als Lotus Notes niet open is open dan het mail-gedeelte ervan.
                  If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
                 
                  'Maak de e-mail en de bijlage.
                  Set noDocument = noDatabase.CreateDocument
                  Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
                  Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stattachment)
                                 
                  'Voeg de gegevens toe aan de gemaakte e-mail eigenschappen.
                  With noDocument
                    .Form = "Memo"
                    .SendTo = vaRecipients
                    .CopyTo = vaCopyTo
                    .Subject = stsubject
                    .Body = vamsg
                    .SaveMessageOnSend = True
                    .PostedDate = Now()
                   .Send 0, vaRecipients
                  End With
                 
                          
                  'Verwijder objecten uit het geheugen.
                  Set noEmbedObject = Nothing
                  Set noAttachment = Nothing
                  Set noDocument = Nothing
                  Set noDatabase = Nothing
                  Set noSession = Nothing
                  
                  MsgBox "De e - mail is correct verstuurd ", vbInformation
                  


End Sub
 
Je kan toch bij de eigenschappen v/d CB LinkedCell instellen op een cel die verborgen is onder de CB en dan deze celwaarde gebruiken in je naam, niet ?
 
Heb het anders kunnen oplossen.
Heb de code als volgd aangepast en het werkt nu.

Code:
  ActiveWorkbook.SaveAs Filename:=("T:\Mag-Data\Mit pc\davy\Mensura Controle\controle al doorgemaild" & "\Controle aanvraag   " & Sheets("controle"). Combobox1.Value & " Doorgestuurd op " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls")
stpath = "T:\Mag-Data\Mit pc\davy\Mensura Controle\controle al doorgemaild" 'locactie waar bijlage staat
stsubject = "Controle aanvraag   " & Sheets("controle").Combobox1.Value & " Doorgestuurd op  " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls" _

Bedankt voor je reactie :thumb:
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan