10. september 2006 - 22:14Der er
17 kommentarer og 2 løsninger
email emne fra forskellige celler automatisk
Jeg taster data ind i 4 celler. Jeg vil have indeholdet til at stå i emnet på en email, jeg skal sende med to vedhæftede filer. Jeg har flere modtagere af email, som alle for forskellige data i de 4 celler. Måske er det ikke en regnearksopgave, men jeg skal jo starte et sted :-)
Hej akyhne,der er et andet sprørgsmål et par dage siden med nøjagtig de sammefiler etc. som jeg efterlyser. Men hvordan sender jeg en fil medtil eksperten? mvh Johnny
men emnet (komma mellem hver celle) abc1, 10:00, rødovre, 18:00, vallensbæk strand, Når dette er tastet ind skal det sendes en email til en modtager med to vedhæftede pdf-filer.
Der vil være mange linier i arket (hvor emnet er som ovenstående) med mange forskellige modtagere.
Det vi skal bruge er en kode til at vedhæfte filer ud fra en celle værdi. koden skal bygges i denne kode her og ud fra en bestemt celle skal den vedhæfte en fil med navn som værdien fra cellen.
End Sub Private Declare Function ShellExecute Lib "shell32.dll" _ Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _ ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long 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 = 2 To 25 'data in rows 2-4 Rem Get the email address Email = Cells(r, 21)
If Cells(r, 21) <> "" Then bygMail r End If Next r End Sub Private Sub bygMail(r) Email = Cells(r, 21) ' Message subject Format(Cells(r, 2), "hh:mm:ss") Subj = "" & "" & Cells(r, 4) & "" & Cells(r, 10) & "" & Cells(r, 16) & "" & Format(Now() + 1, "dddd dd mmmm yyyy") & "" & Format(Now(), "dddd mmmm yy hh:mm")
If (Cells(r, 1)) <> "" Then Msg = Msg & vbCrLf & vbCrLf End If
Select Case (Cells(r, 4)) Case Is = "A" Msg = Msg & vbCrLf Case Is = "B" Msg = Msg & vbCrLf Case Is = "C" Msg = Msg & vbCrLf Case Is = "D" Msg = Msg & vbCrLf Case Is > 0 Msg = Msg & vbCrLf 'Vedhæft fil her End Select
Select Case (Cells(r, 10)) Case Is = "A" Msg = Msg & vbCrLf Case Is = "B" Msg = Msg & vbCrLf Case Is = "C" Msg = Msg & vbCrLf Case Is > 0 Msg = Msg & vbCrLf 'Vedhæft fil her End Select
Select Case (Cells(r, 16)) Case Is = "A" Msg = Msg & vbCrLf Case Is = "B" Msg = Msg & vbCrLf Case Is = "C" Msg = Msg & vbCrLf Case Is > 0 Msg = Msg & vbCrLf 'Vedhæft fil her End Select
Hej Splokit, VB er langt over min formåen, jeg låner lidt på biblo eller køber en bog, jeg har set anbefalet her på eksperten og så vender jeg tilbage. Men jeg ved ikke hvor hurtigt jeg kan fatte det, men foreløbig tak :-)
Denne tager mailadresser i cellerne B1-B4 og mailer (lægges i "Klader" i Outlook). Subject, altså overskriften, tages fra A1-A4, med komma imellem. Den vedhæfter 2 .txt-filer. jeg har ikke lavet kontrol i koden, for om de er der!
For at det virker, skal I i VBA-editoren gå i "Tools", "References", og tilføje "Microsoft Outlook 11 Object Library". Kan også være "Microsoft Outlook 10 Object Library". Det afh;nger af Jeres version. Dette skal gøres på alle maskiner, hvor det skal virke. Ved ikke hvordan man kan lave kontrol for dette.
Skal det tilpasses, kan I bare spørge!
Private Sub CommandButton3_Click() Dim I Dim Besked As String
MailAdrr = Range("B1:B4") For I = 1 To UBound(MailAdrr) If MailAdrr(I, 1) Like "*@*" Then GoSub SendEnMail End If Next
Dim ObjOutlook As Outlook.Application Dim ObjOutLookMsg As Outlook.MailItem Dim ObjOutLookRecip As Outlook.Recipient
Set ObjOutlook = CreateObject("Outlook.Application") Set ObjOutLookMsg = ObjOutlook.CreateItem(olMailItem)
Dim strFilSti As String strFilSti = "C:/test.txt" strFilSti2 = "C:/test2.txt"
ObjOutLookMsg.Save
With ObjOutLookMsg Set ObjOutLookRecip = .Recipients.Add(MailAdrr(I, 1)) ObjOutLookRecip.Type = olTo .Subject = Besked .Body = "Og teksten i mailen" .Attachments.Add strFilSti .Attachments.Add strFilSti2 .Save '.Send 'Fjern det første ' hvis mailen skal sendes End With
Private Sub CommandButton3_Click() Dim I Dim Besked As String, Fil1 As String, Fil2 As String Fil1 = "c:\test1.txt" Fil2 = "c:\test2.txt" If Dir(Fil1) = "" Or Dir(Fil1) = "" Then MsgBox "En af filerne mangler!" Exit Sub End If MailAdrr = Range("B1:B4") For I = 1 To UBound(MailAdrr) If MailAdrr(I, 1) Like "*@*" Then GoSub SendEnMail End If Next
Dim ObjOutlook As Outlook.Application Dim ObjOutLookMsg As Outlook.MailItem Dim ObjOutLookRecip As Outlook.Recipient
Set ObjOutlook = CreateObject("Outlook.Application") Set ObjOutLookMsg = ObjOutlook.CreateItem(olMailItem)
ObjOutLookMsg.Save
With ObjOutLookMsg Set ObjOutLookRecip = .Recipients.Add(MailAdrr(I, 1)) ObjOutLookRecip.Type = olTo .Subject = Besked .Body = "Og teksten i mailen" .Attachments.Add Fil1 .Attachments.Add Fil2 .Save '.Send 'Fjern det første ' hvis mailen skal sendes End With
Hej Akyhne, som jeg skrev lidt højere oppe, jeg er slet ikke på niveau til denne hjælp, jeg aner faktisk ikke, hvor jeg skal putte den ind osv, derfor skrev jeg, at jeg vil låne noget materiale som kan hjælpe mig som total novice og så checke den, som jeg kan se, kvalificerede hjælp jeg får. Jeg skal nok vende tilbage, men der går lidt tid, pointene skal selvfølgelig bruges :-)
Her er den kode lavet om men til den måde du ønsker og er lige til al sy ind til dit behov.
Option Explicit
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 = 4 To 30 'data in rows 2-4 Rem Get the email address Email = Cells(r, 1) If Cells(r, 1) <> "" Then bygMail r 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 = "C:\test\" & Format(Now(), "dddd") & "\" ChDir Disk Filnavn = ".pdf"
Jeg har brugt splokits opsætning med nogle tilrettelser og det virker, tak også til akyhne, mvh Johny
Synes godt om
Ny brugerNybegynder
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.
Ny bruger
Nybegynder
Opret
Preview
