Sub Add_Folder_Share_Drive()

'Set WshNetwork = CreateObject("WScript.Network")

'WshNetwork.RemoveNetworkDrive "Z:"

Dim sharepointFolder As String

Dim colDisks As Variant

Dim objWMIService As Object

Dim objDisk As Variant

Dim driveLetter As String

'Create FSO and network object

Set objNet = CreateObject("WScript.Network")

Set fs = CreateObject("Scripting.FileSystemObject")

'Get all used Drive-Letters

Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\cimv2")

Set colDisks = objWMIService.ExecQuery("Select * from Win32_LogicalDisk")

'Loop through used Drive-Letters

For Each objDisk In colDisks

For i = 65 To 90

'If letter is in use exit loop and remember letter.

If i = Asc(objDisk.DeviceID) Then

j = i

Exit For

'letters which are not checked yet are possible only

ElseIf i > j Then

driveLetter = Chr(i) & ":"

Exit For

End If

Next i

'If a Drive-Letter is found exit the loop

If driveLetter <> "" Then

Exit For

End If

Next

driveLetter = "K:"

'define path to SharePoint

'sharepointFolder = "https://spFolder/Sector Reports/"

sharepointFolder = Range("SharepointFolder")

'Map the sharePoint folder to the free Drive-Letter

objNet.MapNetworkDrive driveLetter, sharepointFolder

'set the folder to the mapped SharePoint-Path

Set folder = fs.GetFolder(driveLetter)

End Sub