Avatar billede CHarms Nybegynder
11. november 2015 - 15:00 Der er 8 kommentarer og
1 løsning

Send udvalg af Rækker fra Excel til Email adresser

Kære Eksperter

Jeg har behov for at sende Rækker fra et Excel ark til den Email adresse der står í rækken

Eksempel:
http://i1175.photobucket.com/albums/r632/Christian_Harms/Excel%20billede_zpsb6b4xnqa.jpg

der skal sendes 1 email til 222@222.dk som indeholder række 2, 5 & 6
og der skal sendes 1 Email til 111@111.dk som indeholder række 3,4 & 7

----------------
Jeg har Googlet som en gal og forsøgt at brevflette med Word, men uden held.
Jeg forestiller mig at der må være en funktion til dette?
11. november 2015 - 15:12 #1
Det kan klares med brevfletning, men du får en mail pr. række i Excel-arket.
Ellers må du omstrukturere dine data.
Avatar billede CHarms Nybegynder
11. november 2015 - 15:32 #2
Hej Erik

Det var netop den mur jeg rendte ind i.
Hvis jeg brugte brevfletningen, ville jeg skulle give spam-kage de næste 30 år ;)

Jeg ville gerne undgå at lave det manuelt.

Og håber at nogen her måske ved hvordan man koder sig ud af sådan en omgang :)
Avatar billede supertekst Ekspert
12. november 2015 - 13:31 #3
Det skulle nok være muligt.

Hvordan skal rækkerne sendes - som vedhæftet fil eller som rækker i selve teksten?

Har du adgang til Outlook?
Avatar billede CHarms Nybegynder
12. november 2015 - 23:24 #4
Hej Supertekst

Helst som vedhæftet fil, men hvis det bliver som rækker i teksten ville det også være OK

Ja, jeg har adgang til outlook
Avatar billede supertekst Ekspert
12. november 2015 - 23:41 #5
Ok - vender tilbage..
Avatar billede supertekst Ekspert
13. november 2015 - 13:06 #6
VBA-koden anbringes under Ark1 / Højre klik / Vis programkode
Hvis du vil have min model - så send en mail. @-adresse uner min profil.


Dim sti As String
Dim antalRækker As Integer, antalKolonner As Integer, ræk As Integer, mailadresse As String
Dim startRæk As Integer, slutRæk As Integer
Dim attFilnr As Integer

Dim systemXLS As Workbook, område As Range, Ws As Worksheet
Dim attXLS As Workbook
Public Sub fordelingAfMails()
    Application.DisplayAlerts = False
   
    sti = ActiveWorkbook.Path & "\"
    Set systemXLS = ActiveWorkbook
    attFilnr = 1
   
    Set Ws = ActiveWorkbook.Sheets(1)
Rem beregn antal rækker
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    antalKolonner = ActiveCell.SpecialCells(xlLastCell).Column
   
Rem sortering iflg. emailadresse
    sortering antalRækker
   
Rem hent første mailadresse
    mailadresse = systemXLS.Sheets(1).Range("C2")
    startRæk = 2
    For ræk = 3 To antalRækker
        If Range("C" & ræk) <> mailadresse Then
            slutRæk = ræk - 1
            klargørTilSendMail startRæk, slutRæk, attFilnr
           
            sendMailen mailadresse, sti, "AttData_" & attFilnr & ".xlsx"
            attFilnr = attFilnr + 1
            startRæk = ræk
            mailadresse = Range("C" & ræk)
        End If
    Next ræk

    klargørTilSendMail startRæk, ræk - 1, attFilnr
   
    sendMailen mailadresse, sti, "AttData_" & attFilnr & ".xlsx"
End Sub
Private Sub klargørTilSendMail(fraRæk, tilRæk, attFilnr)
    ActiveWorkbook.ActiveSheet.Range("A" & fraRæk & ":D" & tilRæk).Select
    Selection.Copy
   
    Workbooks.Open sti & "AttData.xlsx"
    ActiveWorkbook.Sheets(1).Range("A2").Select
    ActiveSheet.Paste
   
    ActiveWorkbook.SaveAs sti & "AttData_" & attFilnr & ".xlsx"
    ActiveWorkbook.Close
End Sub
Private Sub sendMailen(mailadresse, sti, filnavn)
Dim mailApp, Namespace
    Set mailApp = CreateObject("Outlook.application")
    Set Namespace = mailApp.GetNamespace("MAPI")
   
    Set nymail = mailApp.CreateItem(olMailItem)
    Set TilModtager = nymail.Recipients.Add(mailadresse)
   
    nymail.Subject = "Data"                    'Emne
    nymail.Attachments.Add sti & filnavn
    nymail.Display                              'Viser mailen som da kan ajourføres.
'    nyMail.Send            'Ej automatisk under test - fjern ' yderst til venstre
End Sub
Private Sub sortering(antalRækker)
    Range("C1").Select
    ActiveWorkbook.Worksheets("Ark1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ark1").Sort.SortFields.Add Key:=Range("C2:C" & antalRækker), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Ark1").Sort
        .SetRange Range("A1:D" & antalRækker)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Avatar billede supertekst Ekspert
13. november 2015 - 13:07 #7
PS: Anvend Kommentar og ikke Svar. Svar anvendes kun af forslagsstiller.
Avatar billede CHarms Nybegynder
17. november 2015 - 13:55 #8
Tak for hjælpen Supertekst
Du er en ægte helt :)
Avatar billede supertekst Ekspert
17. november 2015 - 14:54 #9
Selv tak
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
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

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