Saving PDF to Sharepoint

[bmsolutions]

Hi everyone,

I am a complete novice when it comes to macros and VBA, but after following a YouTube tutorial I have managed to put together a macro which creates a PDF of the current sheet, and creates an email with said PDF attached.

Here is the code:

Sub EmailasPDF()

Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")

Dim EItem As Object
Set EItem = EApp.CreateItem(0)

Dim advisername As String
Dim invoicedate As String
Dim path As String
Dim fname As String

advisername = Range("B10")
invoicedate = Range("A9")

path = "C:\Users\INSERTUSERNAMEHERE\MISC FOLDER NAME\MISC FOLDER NAME 2\MISC FOLDER NAME 3\MISC FOLDER NAME 4\MISC FOLDER NAME 5\MISC FOLDER NAME 6"
fname = " " & advisername & " " & invoicedate

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, IgnorePrintAreas:=False, Filename:=path & fname

With EItem

.To = Range("G16")
.Subject = advisername & " " & invoicedate
.Body = "Please find invoice attached."
.Attachments.Add (path & fname & ".pdf")
.Display
End With
End Sub

The problem I am having is this only works for me as the user INSERTUSERNAMEHERE (I've anonymised this along with the folder names.)

Ideally, I would like to point this towards a Sharepoint folder (it technically currently is, but it's pointed towards my local version of the Sharepoint folder, rather than to the online folder). If anyone else uses the macro it doesn't work because there username, and there local version of the same Sharepoint folder follows a different file path.)

I've read many similar questions on this forum and tried implementing various solutions but keep running into errors and I'm afraid due to my lack of coding skills I don't have the know how to fix these errors to get this working.

Any help would be much appreciated! Thanks!

 

[Trebor76]

Hi bmsolutions,

Welcome to MrExcel!!

Is this what you're after:

path = "C:\Users\" & Environ("UserName") & "\MISC FOLDER NAME\MISC FOLDER NAME 2\MISC FOLDER NAME 3\MISC FOLDER NAME 4\MISC FOLDER NAME 5\MISC FOLDER NAME 6"

Regards,

Robert

 

[bmsolutions]

Hi bmsolutions,

Welcome to MrExcel!!

Is this what you're after:

path = "C:\Users\" & Environ("UserName") & "\MISC FOLDER NAME\MISC FOLDER NAME 2\MISC FOLDER NAME 3\MISC FOLDER NAME 4\MISC FOLDER NAME 5\MISC FOLDER NAME 6"

Regards,

Robert

Hi Robert,

Many thanks for your input. That works and it doesn't work...

Inserting " & Environ("UserName") & " after \Users\ works on my PC. However it seems the that on other machines the path to get to the same folder is actually a little different example.
My machine: "C:\Users\INSERTUSERNAMEHERE\MISC FOLDER NAME\MISC FOLDER NAME 2
Other machine "C:\Users\INSERTUSERNAMEHERE\OneDrive - MISC FOLDER NAME\MISC FOLDER NAME 2

A slightly different path gets the user to the same folder. I feel that a Sharepoint URL might work better if that's even possible?

 

[Trebor76]

A slightly different path gets the user to the same folder.

That seems odd Maybe there's alias's or something.

I feel that a Sharepoint URL might work better if that's even possible?

I could be wrong but no, not saving a document to the site. You need to get the windows equivalent of the URL.

Maybe try this where you list all the possible directories from which the code keeps checking each until it finds one that does exist or alerts you if none do:

Option Explicit
Sub Macro1()

    Dim varPath As Variant
    Dim strPath As String
    
    For Each varPath In Array("C:\Users\" & Environ("UserName") & "\MISC FOLDER NAME\MISC FOLDER NAME 2\MISC FOLDER NAME 3\MISC FOLDER NAME 4\MISC FOLDER NAME 5\MISC FOLDER NAME 6", _
                              "C:\Users\" & Environ("UserName") & "\OneDrive - MISC FOLDER NAME\MISC FOLDER NAME 2")
    
        varPath = IIf(Right(varPath, 1) <> "\", varPath & "\", varPath)
        If Not Dir(CStr(varPath), vbDirectory) = vbNullString Then
            strPath = CStr(varPath)
            Exit For
        End If
    Next varPath
    
    If Len(strPath) = 0 Then
        MsgBox "None of the proposed directories actually exist." & vbNewLine & "Please check and try again.", vbExclamation
        Exit Sub
    End If

End Sub