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

Prøv at vise koden - i "begge versioner".

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

prøv at fjerne " omkring Link

Så melder den nedenstående fejl?

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

Mvh

Martin

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

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.

Har fået det til at køre - skal lige teste lidt mere..

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

Lukketid?

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

glemte pointgivning...

Ok og selv tak