Avatar billede malldiverne Nybegynder
25. februar 2015 - 20:06 Der er 11 kommentarer og
1 løsning

væftet PDF fil til mail, hvor stien ligger i en celle generet af et lopslag

Hej eksperter,

Jeg med hjælp fra et par eksperter herinden generet et mail system, som sender mails til række medarbejdere på baggrund af nogle kriterier.

Men jeg kunne godt tænke mig, at der blev vedhæftet et pdf dokument til mailen.

Stien til pdf dokumentet står i en celle udefor hver enkelt medarbejder, og er genereret af et lopslag.

Jeg har prøvet at anvende forskellige koder, men har kun fået det til virke, når jeg skriver stien direkte ind i VBA koden, i stedet for at anvende en variabel, da pdf dokument ikke er det samme til alle medarbejdere.

Håber i kan hjælpe!!

Mvh

Martin
Avatar billede supertekst Ekspert
25. februar 2015 - 23:48 #1
Prøv at vise koden - i "begge versioner".
Avatar billede malldiverne Nybegynder
26. februar 2015 - 12:18 #2
Jeg lagt begge versioner ind i nedenstående kode, hvor det ene fungere fint - men når jeg gemmer stien i variabel vil det ikke længere fungere. Den version som virker, kan jeg bare ikke bruge, da den vedhæftede fil skifter alt efter, hvilken afdeling de tilhører.

Jeg har lavet også forsøgt at lave 20 forskellige if sætninger, som bruger den bestemte sti, hvis afdelingen = Link variablen - men dette tager for lang tid, når der skal sender over 400 mails.

Håber du hjælpe!!

Mvh

Martin

Private Sub afsendAfBesked()
   
Worksheets("Mail").Activate
Dim modtager As String, linje As String
       
modtager = Range("g1") ' = Personernes navne
linje = "Dato" & vbTab & vbTab & "    Timer" & vbTab & "Aktivitetsnr" & vbTab & "Aktivitet" & vbCr

For ræk = 1 To ActiveCell.SpecialCells(xlLastCell).Row
    Range("g" & ræk).Activate ' N kolonnen = fejlreg. timer
    If ActiveCell <> modtager Then
        SendMail mail, navn, linje
        modtager = Range("G" & ræk) ' N kolonnen = fejlreg. timer
linje = "Dato" & vbTab & vbTab & "    Timer" & vbTab & "Aktivitetsnr" & vbTab & "Aktivitet" & vbCr

End If

With ActiveSheet
    Set navn = ActiveCell
    Set akt = ActiveCell.Offset(0, 1)
    Set aktnavn = ActiveCell.Offset(0, 2)
    Set regt = ActiveCell.Offset(0, 7)
    Set link = ActiveCell.Offset(0, 8)  ' stien ligger i denne celle, og er generet vha at et lopslag.
    Set bemærkning = ActiveCell.Offset(0, 9)
    Set mail = ActiveCell.Offset(0, 10)
    Set dag = ActiveCell.Offset(0, 3)
   
    linje = linje & dag & vbTab & regt & " timer" & vbTab & "  " & akt & vbTab & "    " & aktnavn & vbCr
   
End With

Next ræk
Rem sidste modtager
  SendMail mail, navn, linje

End Sub

Private Sub SendMail(mail, navn, linje)

  Set objOutlook = CreateObject("Outlook.Application")
  Set objMail = objOutlook.CreateItem(0)
 
With objMail
        .To = mail
        .Subject = "Fejlregistering på aktivitetsniveau"
        .CC = ""
        .body = "Hej" & " " & navn & vbNewLine & vbNewLine & "Vi har fundet nedenstående fejlregisterering der er generet efter et kriterie opsat efter din afdeling." _
        & vbNewLine & vbNewLine & "Du har registeret dig på følgende:" & vbNewLine & vbNewLine & linje & vbNewLine & vbNewLine
       
        '.Attachments.Add ("link") ' Denne virker ikke, men nedenstående løstning, hvor jeg indsætter       
          stien virker fint.
        .Attachments.Add ("H:\WindowsProfil\Skrivebord\Vejledning tidsreg\........pdf") ' Virker fint
        objMail.display 'Instead of .Display, you can use .Send to send the email or .Save to save a copy in  the drafts folder
       
      End With

End Sub
Avatar billede supertekst Ekspert
26. februar 2015 - 12:47 #3
prøv at fjerne " omkring Link
Avatar billede malldiverne Nybegynder
26. februar 2015 - 13:47 #4
Så melder den nedenstående fejl?

[img]/Users/martinsorensen/Desktop/Skærmbillede 2015-02-26 13.45.34.png[img]

Mvh

Martin
Avatar billede malldiverne Nybegynder
26. februar 2015 - 13:50 #5
Avatar billede malldiverne Nybegynder
26. februar 2015 - 13:53 #6
Kan åbenbart ikke lige få billedet op :)

Men den skriver:

run-time error

Automation error
connection to type library or object library for remote process has been lost.
press OK for dialog to remove reference.
Avatar billede supertekst Ekspert
26. februar 2015 - 15:21 #7
Har fået det til at køre - skal lige teste lidt mere..
Avatar billede supertekst Ekspert
26. februar 2015 - 15:29 #8
Fra min version:

Sub afsendAfBesked_3()
Dim modtager As String, linje As String, xLink

    modtager = Range("D1")
    linje = "Dato" & vbTab & "Aktivitet" & vbTab & vbTab & vbTab & "Timer" & vbCr
   
    For ræk = 1 To ActiveCell.SpecialCells(xlLastCell).Row
        Range("K" & ræk).Activate
        If ActiveCell.Offset(0, -7) <> modtager Then
            sendMail mail, navn, linje, xLink
            modtager = Range("F" & ræk)
            linje = "Dato" & vbTab & "Aktivitet" & vbTab & vbTab & vbTab & "Timer" & vbNewLine
        End If
       
        With ActiveSheet
            Set navn = ActiveCell.Offset(0, -7)
            Set orgenhed = ActiveCell.Offset(0, -10)
            Set akt = ActiveCell.Offset(0, -5)
            Set aktnavn = ActiveCell.Offset(0, -6)
            Set regt = ActiveCell
            Set xLink = ActiveCell.Offset(0, 8)
            Set bemærkning = ActiveCell.Offset(0, 2)
            Set mail = ActiveCell.Offset(0, 3)
            Set dag = ActiveCell.Offset(0, -4)
           
            linje = linje & dag & vbTab & aktnavn & vbTab & vbTab & vbTab & regt & vbNewLine
        End With

    Next ræk
   
Rem sidste modtager
    sendMail mail, navn, linje, xLink
End Sub
Private Sub sendMail(mail, navn, linje, xLink)
Dim vedhft                '<---
      Set objOutlook = CreateObject("Outlook.Application")
      Set objmail = objOutlook.CreateItem(0)
     
    With objmail
        .To = mail
        .Subject = "Fejlregistering på aktivitetsniveau"
        .CC = ""
         
        .body = "Hej" & " " & navn & vbNewLine & vbNewLine & "Vi har fundet nedenstående fejlregisterering der er generet efter et kriterie opsat efter din afdeling." _
          & vbNewLine & vbNewLine & "Du har registeret dig på følgende:" & vbNewLine & linje & vbNewLine & "Med venlig hilsen" & vbNewLine & "Controllerenheden"
       
        Set vedhft = .Attachments    '<---
        vedhft = xLink  '<---
        .Attachments.Add vedhft  '<---
    End With
     
      objmail.Send
End Sub
Avatar billede supertekst Ekspert
03. marts 2015 - 15:00 #9
Lukketid?
Avatar billede malldiverne Nybegynder
03. marts 2015 - 15:20 #10
Jeg fik det desværre ikke til virke med ovenstående, men lavede en et par if sætninger med de enkelte dokumenter der skulle vedhæftes.. Var lidt tidspresset på outputtet ;)

Men du får rigtig mange tak for hjælpen, beklager det sene svar.

Mvh

Martin
Avatar billede malldiverne Nybegynder
03. marts 2015 - 15:21 #11
glemte pointgivning...
Avatar billede supertekst Ekspert
03. marts 2015 - 15:47 #12
Ok og 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
Kurser inden for grundlæggende programmering

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