Avatar billede ngunordic Juniormester
12. december 2014 - 12:02 Der er 9 kommentarer

Send mail via makro ved tryk på en knap i excel 2010

HEj

har fundet denne kode fra tidligere..

Sub Knap107_Klik()
Emne = InputBox("Bestilling af")
If Application.MailSystem <> xlNoMailSystem Then
  ActiveSheet.Copy
  With ActiveWorkbook
        .SendMail _
        Recipients:="xxx@xxx.com", _
        Subject:=Emne
        .Close SaveChanges:=False
  End With
Application.MailLogoff
  Else
    MsgBox "Intet Microsoft postsystem er installeret.", vbInformation, "Postmeddelelse"
  End If
End Sub

Når man trykker på knappen bestil, så skal den sendes fra modtagerens outlook - og der skal komme en msgbox op med; "Tak for din bestilling, du hører fra os snarest!"

hele arket vil være låst på nær nogle dropdown menuer og så knappen bestil..

hvad skal jeg gøre for at få dette til at virke?

Altertivt kan man sætte arket med kilde ind i en mail, og sende den rundt? selvom arket er låst?
Avatar billede morten_dalsgaard Praktikant
12. december 2014 - 13:56 #1
Hvis du smider denne ind i dit Excelark i et module:


Sub Mail_workbook_Outlook_2()
   
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object

    Set wb1 = ActiveWorkbook
    If Val(Application.Version) >= 12 Then
        If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
                  "be no VBA code in the file you send. Save the" & vbNewLine & _
                  "file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
            Exit Sub
        End If
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Make a copy of the file.
    ' If you want to change the file name then change only TempFileName variable.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = wb1.Name
    FileExtStr = "." & LCase(Right(wb1.Name, _
                                  Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

    Set OutApp = CreateObject("Outlook.Application")
   
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
  ' Change the mail address and subject in the macro before you run this procedure.
    With OutMail
        .To = "dinegenmail@xxx.com"
        .CC = ""
        .BCC = ""
        .Subject = "Emne i mail"
        .Body = ""
        .Attachments.Add wb2.FullName
        .Send
    End With
    On Error GoTo 0

    wb2.Close SaveChanges:=False

    ' Delete the file.
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
   
        'Range("tilmeld").Select
        'ActiveCell = "tilmelding sendt!"
       
MsgBox "Tak for din bestilling, du hører fra os snarest!"


ActiveWorkbook.Close False

       
End Sub



og opdaterer selv mailadresse/emnefelt osv.

Så gør den det at den går ind i det åbne Outlook program hos brugeren, gemmer en kopi af Excel arket og vedhæfter det i mailen.

Herefter lukker den arket.

Er det noget i den stil, som du skal bruge?

VH
Avatar billede morten_dalsgaard Praktikant
12. december 2014 - 13:57 #2
se bort fra alle de små kommentarer i koden, det er en kode jeg selv har fundet tidligere og tilrettet mit eget..
Avatar billede ngunordic Juniormester
12. december 2014 - 14:37 #3
det er meget, meget tæt på :)

dog åbner den en tom excel fil - det er ikke meningen - kan dette fjernes?

kan det laves sådan, at den åbner en ny mail i outlook, som helt normalt, hvor blot filen er vedhæftet og emnefeltet bestemt.. kunden kan så selv skrive hvad han vil i mailen - og gætter på kundens signatur også kommer med så?
Avatar billede morten_dalsgaard Praktikant
12. december 2014 - 15:01 #4
okay..
jaman prøv med denne:


Sub Mail_workbook_Outlook_2()
 
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object

    Set wb1 = ActiveWorkbook

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Make a copy of the file.
    ' If you want to change the file name then change only TempFileName variable.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = wb1.Name
    FileExtStr = "." & LCase(Right(wb1.Name, _
                                  Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

    Set OutApp = CreateObject("Outlook.Application")
 
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
  ' Change the mail address and subject in the macro before you run this procedure.
    With OutMail
        .To = "dinegenmail@xxx.com"
        .CC = ""
        .BCC = ""
        .Subject = "Emne i mail"
        .Body = ""
        .Attachments.Add wb2.FullName
        .Send
    End With
    On Error GoTo 0

    wb2.Close SaveChanges:=False

    ' Delete the file.
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

     
MsgBox "Tak for din bestilling, du hører fra os snarest!"


ActiveWorkbook.Close False

     
End Sub




Jeg har ikke lige på stående fod et bud på en hvor man selv skal trykke på send.
Jeg kan godt kigge efter det, men det bliver først i næste uge..
Avatar billede Spetslai Nang Praktikant
03. juli 2019 - 11:06 #5
Hej

Nogen der ved hvordan jeg kan få auto signature med i mailen?
Avatar billede morten_dalsgaard Praktikant
03. juli 2019 - 11:21 #6
Avatar billede Spetslai Nang Praktikant
04. juli 2019 - 09:23 #7
Hej Morten

Mange tak. Jeg har dog udfordringer med at excel arket ikke vedhæfter mailen. Jeg har forsøgt at indsætte " .Attachments.Add ActiveWorkbook.FullName ". Det fungere dog ikke :(

Noget du kan hjælpe med?
Avatar billede Slettet bruger
23. januar 2020 - 11:48 #8
Hej

Jeg bruger denne løsning til at kopiere excelarket ind i en ny mail i Outlook, men...

Vi har også Notes brugere der skal kunne bruge denne, så jeg tænkte om der var nogen der kunne knække den for mig. Det er lidt over min fatte evne at få åbnet enten det ene eller det andet mailprogram
Avatar billede Slettet bruger
23. januar 2020 - 11:50 #9
Glemte lige at sende min kodning med :-)

Sub NDI_bestil_mail()
 
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object
   
    Emne = InputBox("Noter bilens registrerings nummer her")

    Set wb1 = ActiveWorkbook
    If Val(Application.Version) >= 12 Then
        If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
                  "be no VBA code in the file you send. Save the" & vbNewLine & _
                  "file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
            Exit Sub
        End If
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Make a copy of the file.
    ' If you want to change the file name then change only TempFileName variable.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = wb1.Name
    FileExtStr = "." & LCase(Right(wb1.Name, _
                                  Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

    Set OutApp = CreateObject("Outlook.Application")
 
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
  ' Change the mail address and subject in the macro before you run this procedure.
    With OutMail
        .To = "din@mail.dk"
        .CC = ""
        .BCC = ""
        .Subject = Emne
        .Body = ""
        .Attachments.Add wb2.FullName
        .Send
    End With
    On Error GoTo 0

    wb2.Close SaveChanges:=False

    ' Delete the file.
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
        'Range("Bestil").Select
        'ActiveCell = "Bestiling sendt!"
     
MsgBox "Tak for din bestilling."


ActiveWorkbook.Close False

     
End Sub
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
IT-kurser om Microsoft 365, sikkerhed, personlig vækst, udvikling, digital markedsføring, grafisk design, SAP og forretningsanalyse.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester