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?
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)))
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
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å?
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)))
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..
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?
Synes godt om
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
Synes godt om
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)))
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
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.