Avatar billede HHA Professor
17. februar 2021 - 08:47 Der er 1 kommentar og
1 løsning

Problem med at vedhæfte fil i mail.

Hejsa,

Jeg roder rundt med nedenstående kode, hvor jeg kan gemme et ark som PDF og maile det.

Det er sat sammen af 2 koder.
Den øverste del, gemmer filen hvor den skal.
Den nederste del, under "''XXXXXXXXXXXX" opretter en midlertidig fil som den vedhæfter og sletter efterfølgende.
Det har virket fint.
Jeg har lavet en ændring til den øverste del af koden, hvor den tager mappe stien af det aktive excel ark, går en mappe og ind i en anden mappe og gemmer. Det virker stadigvæk fint.

Nu er problemet at den nederste del af koden ikke kan finde ud af det.
Den opretter en mail med en vedhæftet fil, som er den rigtige, dog med et filnavn der er xxxx.xx.pdf (den er med x'er). Denne fil gemmer den så 4 tilbage klik i stifinder. Mærkeligt.
Den bliver ej heller slettet efter afsendelse af mail.

Kan man få den til at droppe det med at lave en midlertidigt fil og bare vedhæfte den som den allerede har gemt?

Hvad er det jeg har misset i dette?

PS: Det er ikke en fast sti (C:blabla\test\her) der køres, men kun en fast sti mellem nogle mapper, hvor fx blabla kan variere.


KODE: Sub Gem_som_PDF_OG_mail_dansk()
'
' Gem_som_PDF_OG_mail Makro
'
' Dette generer en PDf fil og gemmer den i samme mappe som TO Kalk arket, med nyt TO nummer hver gang.
Dim thisPath As String, docName As String, Title As String

Title = "TO " & Sheets("TO dansk").Range("C4") & " - " & Range("C6") & " - " & Format(Range("C5"), "dd-mmm-yyyy")

thisPath = Left(Application.ActiveWorkbook.Path, InStrRev(Application.ActiveWorkbook.Path, "\") - 1) ' Dette sætter stien en mappe tilbage


docName = thisPath & "\TO Aftalesedler\TO " & Sheets("TO dansk").Range("C4") & " - " & Range("C6") & " - " & Format(Range("C5"), "dd-mmm-yyyy") ' \TO Aftalesedler går ind i mappen TO aftalesedler og genner filen med start af filnavnet med TO


Sheets("TO dansk").Activate
'Range("C4").Select
With Sheets("TO dansk")
    .ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=docName, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False 'True
End With

'XXXXXXXXXXXXXXXXXXXXX

' Nedenstående laver en midlertidig PDF fil, som sendes og slettes igen.

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Signature As String 'Title As String
  Dim OutlApp As Object
  Dim strbody As String
 
  'Titel på email kan angives i nedenstående celle
  'Title = Range("B4") & "  -  " & Range("D4")

  'Angiv PDF filnavn
  'PdfFile = ActiveWorkbook.FullName
  PdfFile = docName '& ".pdf"
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & ".pdf"

  'Eksporter aktive Ark som PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  'Hvis Outlook er åben, så brug den
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

    'Her indsættes den HTML tekst som skal inkluderes i Body sektionen
        strbody = "<BODY style=font-size:10pt;font-family:Calibri>Hej" & _
        "<br><br>Hermed fremsendes tilbud på aftalte tillægsordre, som PDF format.<br><br>" & _
        "Venligst bekræft om tillægsordren kan godkendes og at vi kan gå i gang med den. <br><br>" & _
        "Ser frem til at høre fra dem."

    'Forbered e-mail med PDF vedhæftning
    With OutlApp.CreateItem(0)
      .Display
      .To = "" 'Range("G4").Value ' <-- Refererer til cellen med email adresse for personen der modtager mailen
      .CC = "" ' <-- Indsæt anden modtager her
      .Subject = Title
      .HTMLBody = strbody & "<br>" & .HTMLBody
      .Attachments.Add PdfFile
      '.Send

    'Afsendelse, hvis man laver den med en mailadresse, så kan den sende direkte. Så skal man lige huske .Send oven over også.
  ' On Error Resume Next
  ' Application.Visible = True
  ' If Err Then
  '  CreateObject("WScript.Shell").Popup "E-mail'en blev ikke sendt", 1
  '  Else
  '  CreateObject("WScript.Shell").Popup "E-mail'en blev sendt", 1
    ' .Send

    'End If
    On Error GoTo 0
  End With

  'Sletter oprettede PDF fil
  'Kill PdfFile

  'Luk Outlook, hvis det blev startet af denne kode
  If IsCreated Then OutlApp.Quit

  'Tøm variabel hukommelsen
  Set OutlApp = Nothing
 
'  Range("E4").Select
'  ActiveCell.FormulaR1C1 = "P"
'  ActiveCell.FormulaR1C1 = "Ingen fejl"
' Range("A1").Select

End Sub
Avatar billede ebea Ekspert
17. februar 2021 - 11:08 #1
Ja, jeg kan godt se, at der virkelig er rodet rundt.
Hvorfor laver du det ikke sådan, at i stedet for at definere alt det med at gemme, ("her og der, og 1 tilbage og..."), så åbner du for din stifinder, og klikker dig hen til det sted hvor filen skal gemmes. Og så laver den kode jeg sendte i går, stadig sendingen!

Men det er lidt svært at gennemskue dit uploadede eks., hvor du har Rem'et størsteparten ud.
Avatar billede HHA Professor
23. februar 2021 - 21:31 #2
ebea har sendt mig en løsning.
Stor tak til ebea!!!
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

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