Oprettelse af knapper

Forudsat at Navn står i f.eks. celle B1, og at filen skal gemmes det samme sted blot under det nye navn, og at måned angives som et tal fra 1 til 12:

Gem og Luk:

Private Sub cmdGemogLuk()
  Dim Sti As String, Navn As String
  Sti = ActiveWorkbook.Path
  Navn = "Timeregistrering " & Cells(1, 2).Value & Date
  If Cells(1, 2).Value = "" Then
    If vbNo = MsgBox("Der er ikke angivet et navn. Vil du gemme filen som " & Navn & "?", vbYesNo) Then
      MsgBox "Fil ikke gemt"
      Exit Sub
    End If
  End If
  ActiveWorkbook.SaveAs Filename:=Sti & "\" & Navn
  MsgBox "Fil gemt som " & Navn & " i mappen " & Sti
  'Application.Quit
End Sub

Du kan også vælge helt af droppe if-sætningerne - de er blot en ekstra service til brugeren.

Gem og Send:

Det meste fra Gem og Luk går igen (så det kunne jo laves som en seperat procedure). Men du bliver nødt til at kommunikere med outlook - eller hvilket program du nu bruger. Og det er straks værre - og noget jeg vil lade de rigtige eksperter svare på. Har du overvejet om det nu også ER det du vil - starte et emailprogram op, vedhæfte en fil og sende en mail fra en macro der udføres i Excel?

Jeg tror du skal have fat i Dim obj_Outlook As Outlook.Application - og så vil jeg lade de næste 20-50 linier op til de kloge ;o) (Men er med på en lytter)

/Martin

NB: Du skal naturligvis fjerne tegnet ' foran Application.Quit ;o)

Nå ja - nu kommer hele datoen med i filnavnet. Brug Month(Date) for blot at få den aktuelle måned...

Prøv lige denne, den virker desværre ikke på alle maskiner.Private Sub cmdGemogSend()
  Dim Sti As String, Navn As String
  Sti = ActiveWorkbook.Path
  Navn = "Timeregistrering " & Cells(1, 2).Value & Date
  If Cells(1, 2).Value = "" Then
    If vbNo = MsgBox("Der er ikke angivet et navn. Vil du gemme filen som " & Navn & "?", vbYesNo) Then
      MsgBox "Fil ikke gemt"
      Exit Sub
    End If
  End If
  ActiveWorkbook.SaveAs Filename:=Sti & "\" & Navn
**************************************
  Application.Dialogs(xlDialogSendMail).Show _
arg1:="navn@domaene.dk", _
arg2:="Her er subjektlinien"
******************************
  MsgBox "Fil gemt som " & Navn & " i mappen " & Sti
  'Application.Quit
End Sub

Doh! - word har jo en funktion der hedder "send til > postmodtager". Veg havde noget helt andet i tankerne - noget med at man skulle starte et mail-program osv. osv. Så er det jo ikke så kompliceret endda ;o) /Martin

Mange tak for begge indlæg. Men martin, du skriver at det ik er så kompliceret alligevel. Hvad skal man så gøre?

En funktion til at sende post kunne skrives som følger :

Function SendMail(mvarRec As String, mvarSubj As String, mvarBody As String, Optional mvarAttachment As String) As Boolean

on error goto errorhandler


Dim objSession As MAPI.Session
Dim objMessage As Message
Dim objRecip As Recipient
Dim objAttachment As Attachment

Set objSession = New MAPI.Session
objSession.Logon

Set objMessage = objSession.Outbox.Messages.Add
objMessage.Subject = mvarSubj
objMessage.Text = mvarBody

Set objRecip = objMessage.Recipients.Add
objRecip.Name = mvarRec
objRecip.Type = CdoTo
objRecip.Resolve

If mvarAttachment <> "" Then
    Set objAttachment = objMessage.Attachments.Add
    objAttachment.ReadFromFile mvarAttachment
    objAttachment.Name = "File from me"
End If

objMessage.Update
objMessage.Send showDialog:=False
objSession.Logoff
SendMail=true

exit function

errorhandler:
sendmail=false

End Function

/Xelor

Funktionen forudsætter at der sættes referencer til CDO 1.21.

Objektet er en del af Outlook, men bliver ikke installeret som standard. De vælget til under punktet Dataudveksling (eller noget i den stil)

/Xelor

Denne funktion gemmer og sender aktuelt regneark som vedhæftet fil. Uden errorhandler men på noget færre linier kode. Den forudsætter at navnet står i celle p1, men det kan hurtigt ændres. Modtager navnet skal selvfølgelig også ændres:

Sub GemSend()


navn = Range("p1").Value
md = Month(Date)

    ActiveWorkbook.SaveAs Filename:= _
        "C:\bifmedlem\" & "timeregistrering " & navn & " " & md & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.SendMail Recipients:="bruger@server.dk", Subject:="Dette er en Prøve"
    ActiveWindow.Close
End Sub