19. oktober 2007 - 05:32Der er
14 kommentarer og 1 løsning
sende excel fil automatisk, når der er aviklet en VBA kode
Hej jeg fandt denne kode her på eksperten og satte den ind i et nyt regneark under ark 1, og det virkede fint:
Option Explicit Sub SendTil() ActiveWorkbook.SendMail Recipients:="xxxxx@email.dk", Subject:="Vedhæftet ark" End Sub
Mit spørgsmål er, jeg har et regneark med 2 ark og 4 moduler, hvor jeg har behov for at sende ark1 videre til to faste modtagere. I modul 1 er der en masse kommandoer, der sender mail til forskellige modtagere, alt efter hvad jeg har tastet ind i ark1. Det er, når jeg "bruger" dette modul, at jeg også vil have sendt ark1. Jeg har sat ovennævnte ind først i arket, men den virker ikke. Kan I hjælpe mig?
Modul1
Option Explicit
Sub SendTil() ActiveWorkbook.SendMail Recipients:="johnnymadsen@email.dk", Subject:="Vedhæftet ark" End Sub
Sub SendEMail() Dim Email As String, Subj As String Dim MSG As String, URL As String Dim r As Integer, x As Double
For r = 5 To 26 'data in rows 2-4 Rem Get the email address Email = Cells(r, 3) If Cells(r, 3) > "" Then bygMail r ' Else ' Cells(r, 7).Interior.ColorIndex = 3
End If Next r End Sub Private Sub bygMail(r) Dim mailThis As Outlook.MailItem Dim MSG As String Dim Email As String Dim Subj As String Dim Disk As String, Filnavn As String Dim x As Long Disk = Cells(2, 6) & Format(Cells(2, 7), "dddd") & "\" ChDir Disk Filnavn = ".pdf"
If (Cells(19, 26)) <> "" Then MSG = MSG & Cells(19, 26) & vbCrLf End If If (Cells(20, 26)) <> "" Then MSG = MSG & Cells(20, 26) & vbCrLf End If
If (Cells(21, 26)) <> "" Then MSG = MSG & Cells(21, 26) & vbCrLf End If If (Cells(22, 26)) <> "" Then MSG = MSG & Cells(22, 26) & vbCrLf End If If (Cells(23, 26)) <> "" Then MSG = MSG & Cells(23, 26) & vbCrLf End If If (Cells(24, 26)) <> "" Then MSG = MSG & Cells(24, 26) & vbCrLf End If
MSG = MSG & "Din rådighedstid starter ca dagens timetal trukket fra sluttiden. Spontanture kan forekomme!!" & vbCrLf
If Application.Wait(Now + TimeValue("0:00:02")) Then Cells(r, 7) = "X" End If
Next mailThis.Recipients.Add Email mailThis.Subject = Subj mailThis.Body = MSG mailThis.Send 'Send mailen med det samme!! ' mailThis.Save 'Gem mailen i kladder. Men hvis outlook er lukket bliver de lavt i inbox!! ' mailThis.Display
Denne side indeholder artikler med forskellige perspektiver på Identity & Access Management i private og offentlige organisationer. Artiklerne behandler aktuelle IAM-emner og leveres af producenter, rådgivere og implementeringspartnere.
Jeg har bygget lidt om på makroen "bygMail", prøv at se om det virker.
den første burde se sådan ud
Sub SendTil() Sheets("Ark1").Copy ActiveWorkbook.SendMail Recipients:="johnnymadsen@email.dk", Subject:="Vedhæftet ark" ActiveWindow.Close False End Sub
Sub SendEMail() Dim Email As String, Subj As String Dim MSG As String, URL As String Dim r As Integer, x As Double
For r = 5 To 26 'data in rows 2-4 Rem Get the email address Email = Cells(r, 3) If Cells(r, 3) > "" Then bygMail r ' Else ' Cells(r, 7).Interior.ColorIndex = 3
End If Next r End Sub Private Sub bygMail(r) Dim mailThis As Outlook.MailItem Dim MSG As String Dim Email As String Dim Subj As String Dim Disk As String, Filnavn As String Dim x As Long Disk = Cells(2, 6) & Format(Cells(2, 7), "dddd") & "\" ChDir Disk Filnavn = ".pdf"
If (Cells(19, 26)) <> "" Then MSG = MSG & Cells(19, 26) & vbCrLf End If If (Cells(20, 26)) <> "" Then MSG = MSG & Cells(20, 26) & vbCrLf End If
If (Cells(21, 26)) <> "" Then MSG = MSG & Cells(21, 26) & vbCrLf End If If (Cells(22, 26)) <> "" Then MSG = MSG & Cells(22, 26) & vbCrLf End If If (Cells(23, 26)) <> "" Then MSG = MSG & Cells(23, 26) & vbCrLf End If If (Cells(24, 26)) <> "" Then MSG = MSG & Cells(24, 26) & vbCrLf End If
MSG = MSG & "Din rådighedstid starter ca dagens timetal trukket fra sluttiden. Spontanture kan forekomme!!" & vbCrLf
If Application.Wait(Now + TimeValue("0:00:02")) Then Cells(r, 7) = "X" End If
Next mailThis.Recipients.Add Email mailThis.Subject = Subj mailThis.Body = MSG mailThis.Send 'Send mailen med det samme!! ' mailThis.Save 'Gem mailen i kladder. Men hvis outlook er lukket bliver de lavt i inbox!! ' mailThis.Display
Private Sub bygMail(r) Dim mailThis As Outlook.MailItem Dim MSG As String Dim Email As String Dim Subj As String Dim Disk As String, Filnavn As String Dim x As Long Disk = Cells(2, 6) & Format(Cells(2, 7), "dddd") & "\" ChDir Disk Filnavn = ".pdf"
If (Cells(19, 26)) <> "" Then MSG = MSG & Cells(19, 26) & vbCrLf End If If (Cells(20, 26)) <> "" Then MSG = MSG & Cells(20, 26) & vbCrLf End If
If (Cells(21, 26)) <> "" Then MSG = MSG & Cells(21, 26) & vbCrLf End If If (Cells(22, 26)) <> "" Then MSG = MSG & Cells(22, 26) & vbCrLf End If If (Cells(23, 26)) <> "" Then MSG = MSG & Cells(23, 26) & vbCrLf End If If (Cells(24, 26)) <> "" Then MSG = MSG & Cells(24, 26) & vbCrLf End If
MSG = MSG & "Din rådighedstid starter ca dagens timetal trukket fra sluttiden. Spontanture kan forekomme!!" & vbCrLf
If Application.Wait(Now + TimeValue("0:00:02")) Then Cells(r, 7) = "X" End If
mailThis.Recipients.Add Email mailThis.Subject = Subj mailThis.Body = MSG mailThis.Send 'Send mailen med det samme!! ' mailThis.Save 'Gem mailen i kladder. Men hvis outlook er lukket bliver de lavt i inbox!! ' mailThis.Display
Det virkede ikke. Jeg kalder første ark for "Plan", men det har jeg naturligvis ændret i koden. Jeg kunne godt tænke mig, at alle de mails jeg sender bliver sendt først, de bliver nemlig krydset af i arket, når de er sendt, inden det første ark bliver sendt til mig. Kan man ikke bare sætte et nyt modul på efter, eller hvordan er det? mvh Johnny
Sub SendTil() Sheets("Ark1").Copy ActiveWorkbook.SendMail Recipients:="johnnymadsen@email.dk", Subject:="Vedhæftet ark" ActiveWindow.Close False End Sub
Næh, den virkede ikke. :-( Jeg har prøvet at sætte den alene ind i et modul, det virkede ikke
Men det andet virker som normalt. Jeg bruger noget der hedder noget i retning af rendemtion og et lille program der siger ja til at sende email, så jeg ikke skal sidde og acceptere hver enkelt email, men det skulle vel ikke have indflydelse?
Hvis jeg bruger nedenstående og kører makroen manuelt, så virker den fint. Jeg har flere moduler og har sat koden ind i modul 5. Men meningen er, at når Modul 1 er blevet kørt, så skal denne kode automatisk gå i gang og sende en kopi af det hændte til mig. Eller skal jeg indsætte en knap? til at afvikle den
Mvh johnny godt link! selvom jeg ikke helt forstår, hvordan præcist koden sættes ind, om der er i ThisWorkBook osv,
Sub Mail_workbook_1() 'Working in 97-2007 Dim wb As Workbook
Set wb = ActiveWorkbook
If Val(Application.Version) >= 12 Then If wb.FileFormat = 51 And wb.HasVBProject = True Then MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _ "Save the file first as xlsm and then try the macro again.", vbInformation Exit Sub End If End If
On Error Resume Next wb.SendMail "johnnymadsen@email.dk", _ "This is the Subject line" On Error GoTo 0
Alligevel ikke helt godt. Hver gang der bliver sendt en mail, bliver der også sendt en kopi af regnearket. I dag sendte vi 18 mails og jeg fik 18 kopier af arket. hvordan kan jeg begrænse til 1?
Hvis du bruer den kode du viser i spørgsmålet, så skal den ind sådan, uden for løkken.
Sub SendEMail() Dim Email As String, Subj As String Dim MSG As String, URL As String Dim r As Integer, x As Double
For r = 5 To 26 'data in rows 2-4 Rem Get the email address Email = Cells(r, 3) If Cells(r, 3) > "" Then bygMail r ' Else ' Cells(r, 7).Interior.ColorIndex = 3
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.
