I'm fairly new to this so bear with me.
I have a code that stores a sheet at a specific location in sharepoint, then attaches the file to an outlook email with some text etc. and displays it.
The filename in sharepoint turns out fine, but the in the attachment all spaces in the pdf file name is replaced with %20.
Can anyone please help with spotting the error in my code?
CODE:
Sub SavePdfAndSendEmail()
On Error GoTo err_handler
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim currentDate As String
Dim project As String
Dim mottaker As String
Dim folderPath As String
Dim pdfFileName As String
Dim pdfFullName As String
Dim duplicateNumber As Long
'// Construct the file name
currentDate = Format(Date, "dd-mm-yyyy")
project = Sheets("Endringsskjema UE").Range("E13").Value
mottaker = Sheets("Endringsskjema UE").Range("I13").Value
' folderPath = "C:\Temp\"
folderPath = Sheets("Endringsskjema UE").Range("J5").Value
pdfFileName = "Varsel nr " & Sheets("Endringsskjema UE").Range("E10").Value & " - " & project & " - " & mottaker & " - " & currentDate
duplicateNumber = 1
''' Dir() virker ikke direkte i Sharepoint så her må det lages en ny sjekk
''' Evt prøv å åpne, skal da gi feil.
''' Hvis filen kan åpnes finnes den og duplicate number må da genereres...
' '// Check if the file already exists
' If Dir(folderPath & pdfFileName & ".pdf") <> "" Then
' '// The file exists so append duplicateNumber to the file name and check if that also exists, if it does increment duplicateNumber and test again. Rinse and repeat.
' Do While Dir(folderPath & pdfFileName & "-" & Format(duplicateNumber, "000") & ".pdf") <> ""
' duplicateNumber = duplicateNumber + 1
' Loop
' '// Construct the new file name
' pdfFileName = pdfFileName & "-" & Format(duplicateNumber, "000")
' End If
'// Construct the full name (path, file name and extension)
pdfFullName = folderPath & pdfFileName & ".pdf"
'// Export the workbook as PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFullName
'// Open Outlook and create a new email
Set oApp = New Outlook.Application
Set oMail = oApp.CreateItem(olMailItem)
With oMail
.To = Sheets("Endringsskjema UE").Range("J4").Value
.CC = Sheets("Info og PK-plan").Range("E4").Value
.Subject = "Varsel om endring eller utrekk fra kontrakt_" & pdfFileName
.body = "Se vedlagt varsel om endring eller uttrekk fra kontrakt " 'This is the text that will appear in the body of the email. Remove it if not needed.
.Attachments.Add Source:=pdfFullName, Type:=xlTypePDF
.Display 'This will display the email so you can review it before sending. If you want to send it automatically replace .Display with .Send
End With
clean_exit:
Set oMail = Nothing
Set oApp = Nothing
Exit Sub
err_handler:
'Something has gone wrong, spit out an error messsage
MsgBox "The following error has occured: " & vbNewLine & Err.Number & ": " & Err.Description, vbCritical, "Error!"
GoTo clean_exit
End Sub
Outlook:
Sharepoint:
I have a code that stores a sheet at a specific location in sharepoint, then attaches the file to an outlook email with some text etc. and displays it.
The filename in sharepoint turns out fine, but the in the attachment all spaces in the pdf file name is replaced with %20.
Can anyone please help with spotting the error in my code?
CODE:
Sub SavePdfAndSendEmail()
On Error GoTo err_handler
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim currentDate As String
Dim project As String
Dim mottaker As String
Dim folderPath As String
Dim pdfFileName As String
Dim pdfFullName As String
Dim duplicateNumber As Long
'// Construct the file name
currentDate = Format(Date, "dd-mm-yyyy")
project = Sheets("Endringsskjema UE").Range("E13").Value
mottaker = Sheets("Endringsskjema UE").Range("I13").Value
' folderPath = "C:\Temp\"
folderPath = Sheets("Endringsskjema UE").Range("J5").Value
pdfFileName = "Varsel nr " & Sheets("Endringsskjema UE").Range("E10").Value & " - " & project & " - " & mottaker & " - " & currentDate
duplicateNumber = 1
''' Dir() virker ikke direkte i Sharepoint så her må det lages en ny sjekk
''' Evt prøv å åpne, skal da gi feil.
''' Hvis filen kan åpnes finnes den og duplicate number må da genereres...
' '// Check if the file already exists
' If Dir(folderPath & pdfFileName & ".pdf") <> "" Then
' '// The file exists so append duplicateNumber to the file name and check if that also exists, if it does increment duplicateNumber and test again. Rinse and repeat.
' Do While Dir(folderPath & pdfFileName & "-" & Format(duplicateNumber, "000") & ".pdf") <> ""
' duplicateNumber = duplicateNumber + 1
' Loop
' '// Construct the new file name
' pdfFileName = pdfFileName & "-" & Format(duplicateNumber, "000")
' End If
'// Construct the full name (path, file name and extension)
pdfFullName = folderPath & pdfFileName & ".pdf"
'// Export the workbook as PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFullName
'// Open Outlook and create a new email
Set oApp = New Outlook.Application
Set oMail = oApp.CreateItem(olMailItem)
With oMail
.To = Sheets("Endringsskjema UE").Range("J4").Value
.CC = Sheets("Info og PK-plan").Range("E4").Value
.Subject = "Varsel om endring eller utrekk fra kontrakt_" & pdfFileName
.body = "Se vedlagt varsel om endring eller uttrekk fra kontrakt " 'This is the text that will appear in the body of the email. Remove it if not needed.
.Attachments.Add Source:=pdfFullName, Type:=xlTypePDF
.Display 'This will display the email so you can review it before sending. If you want to send it automatically replace .Display with .Send
End With
clean_exit:
Set oMail = Nothing
Set oApp = Nothing
Exit Sub
err_handler:
'Something has gone wrong, spit out an error messsage
MsgBox "The following error has occured: " & vbNewLine & Err.Number & ": " & Err.Description, vbCritical, "Error!"
GoTo clean_exit
End Sub
Outlook:
Sharepoint:
