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