PDA

View Full Version : [SOLVED:] Filename %20 when adding Workbook from SharePoint in Email



RAECH
05-27-2021, 11:34 PM
Hi everyone

I have a code to send an email, that I need every week for my companies weekly accounts.

I have a workbook where I prepare my accounting data, where I have a specific range consisting of the weekly overview that I put into a new workbook that is saved in SharePoint.
This new workbook is then send out to multiple recipients.

The code works - however, I have an issue with the name of the attached file..

SharePoint handles " " (spaces) as %20 in the link addresses (or what do we call the website address?), file names and more. But this is no issue when I am saving the new workbook into SharePoint.
With my code the new Workbook name is saved as e.g. "SalgsDB - Week 20.xlsx" - which is what I want.

The problem arrives when I need to send til file as an attachment. Excel converts the name into ""SalgsDB%20-%20Week%2020.xlsx" which, to be honest, is annoying me - and my co-workers have asked if we could go back to the old file names (that is, with just normal spaces) as before we started using SharePoint.

I therefore hope, that someone have encountered this before AND have a solution of how to change the code so that the name of the attachment is the same as the saved file.

My code:

Sub SendWeeklies_NewCode()

Dim OlApp As Object
Dim NewMail As Object
Dim NewWb As Workbook
Dim NameOfFile As String
Dim Recipient As String
Dim CCRecipient As String
Dim FilePath As String


NameOfFile = Range("WeekliesName").Value
Recipient = Range("Reciever").Value
CCRecipient = Range("CCReciever").Value
FilePath = Range("WAFilePath").Value




Range("Weeklies").Copy
Set NewWb = Workbooks.Add
NewWb.Activate
Range("B2").PasteSpecial xlPasteAll
Range("B2").PasteSpecial xlPasteColumnWidths
Range("B2").PasteSpecial xlPasteValues
Application.CutCopyMode = False


Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FilePath & NameOfFile
Application.DisplayAlerts = True




Set OlApp = CreateObject("Outlook.application")
Set NewMail = OlApp.createitem(0)


With NewMail
.To = Recipient
.cc = CCRecipient
.Subject = NameOfFile
.attachments.Add (FilePath & NameOfFile & ".xlsx")
.Body = "Hermed denne uges SalgsDB."
.send
End With


Set NewMail = Nothing
Set OlApp = Nothing


NewWb.Close savechanges:=False


End Sub

Note: We a using the SharePoint online, and are therefore not using the synchronising function to our computers.

Thank you in advance :-)

Best regards,
Rasmus

Artik
05-30-2021, 09:10 AM
Please try the code below. In addition to saving to Sharepoint, the file is temporarily saved in the TEMP folder. After shipment, the temporary file is deleted.
Sub SendWeeklies_NewCode_1()

Dim OlApp As Object
Dim NewMail As Object
Dim NewWb As Workbook
Dim NameOfFile As String
Dim Recipient As String
Dim CCRecipient As String
Dim FilePath As String




NameOfFile = Range("WeekliesName").Value
If LCase(Right(NameOfFile, 5)) <> ".xlsx" Then
NameOfFile = NameOfFile & ".xlsx"
End If
Recipient = Range("Reciever").Value
CCRecipient = Range("CCReciever").Value
FilePath = Range("WAFilePath").Value




Range("Weeklies").Copy


Set NewWb = Workbooks.Add(Template:=xlWBATWorksheet)


With NewWb.Worksheets(1)
.Range("B2").PasteSpecial xlPasteAll
.Range("B2").PasteSpecial xlPasteColumnWidths
.Range("B2").PasteSpecial xlPasteValues


Application.CutCopyMode = False
Application.DisplayAlerts = False


'save into SharePoint...
.Parent.SaveAs Filename:=FilePath & NameOfFile, FileFormat:=xlOpenXMLWorkbook


'... and save in TEMP folder (locally)
.Parent.SaveAs Filename:=Environ("TEMP") & Application.PathSeparator & NameOfFile, FileFormat:=xlOpenXMLWorkbook


Application.DisplayAlerts = True
End With






Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)




With NewMail
.To = Recipient
.CC = CCRecipient
.Subject = Left(NameOfFile, Len(NameOfFile) - 5)
'attach from TEMP
.Attachments.Add NewWb.FullName '(Environ("TEMP") & Application.PathSeparator & NameOfFile)
.Body = "Hermed denne uges SalgsDB."
.Display 'Send (After successful tests, replace with Send)
End With




Set NewMail = Nothing
Set OlApp = Nothing




NewWb.Close SaveChanges:=False


'remove file from TEMP
On Error Resume Next
Kill Environ("TEMP") & Application.PathSeparator & NameOfFile
On Error GoTo 0


End Sub
Artik

SamT
05-30-2021, 01:11 PM
SalesDB_Week_20.xlsx

NameOfFile = Range("WeekliesName").Value
NameOfFile = Replace(NameOfFile, " - ", "_")
NameOfFile= Replace(NameOfFile, " ", "_")