Hi!
This code works beautifully at work on Win 10 but not so much for Win 7 machines. They die on the MapNetworkDrive statement below. Is it due to Windows Credentials not being available?
MapNetworkDrive 'Map SharePoint Online ATHLETICS Approved Documents as Network drive P:
Here is an excerpt:
--------------------------------------------
Option Explicit
Public objFS As Object
Public objNet As Object
Public objFile As Object
Public objFolder As Object
Public WSD As Worksheet
Public strToFolder As String
Public strDirectory As String
Public strToFileName As String
Public strArtifactName As String
Public strFromFileName As String
Public strNTSUFolder As String
Public strSPOLnetworkDrive As String
Public strSharepointAddress As String
Public strSharepointPath As String
Public intI As Integer
Public intFinalRow As Integer
Public strUser$, strPassword$, strNetworkDrive$
-----------------------------------------------------------------------------
Sub CopyFilesTo1stFolder()
strSharepointPath = "xxxxxxxxxxxxxxxxxxxxxxxx"
strNTSUFolder = Application.InputBox("Enter ATHL NTSU ID to build the folder")
If strNTSUFolder = "False" Then 'Get the starting folder
MsgBox "Nothing entered.....Good bye"
Exit Sub
End If
strNTSUFolder = Trim(strNTSUFolder) 'Remove trailing spaces'
strToFolder = "M:\NTSU Systems\ NTSU Folders\ATHL NTSU" & strNTSUFolder
strNetworkDrive = "P:"
MapNetworkDrive 'Map SharePoint Online ATHLETICS Approved Documents as Network drive P:
If Len(Dir("" & strToFolder & "", vbDirectory)) = 0 Then
MkDir strToFolder
Else
MsgBox "This folder already exists " & strToFolder
Exit Sub
End If
Set WSD = ThisWorkbook.Worksheets("Listing")
intFinalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
MsgBox "COMPLETE - Folder " & strNTSUFolder & " created in M:\NTSU Systems\ NTSU Folders\ATHL NTSU"
End Sub
This code works beautifully at work on Win 10 but not so much for Win 7 machines. They die on the MapNetworkDrive statement below. Is it due to Windows Credentials not being available?
MapNetworkDrive 'Map SharePoint Online ATHLETICS Approved Documents as Network drive P:
Here is an excerpt:
--------------------------------------------
Option Explicit
Public objFS As Object
Public objNet As Object
Public objFile As Object
Public objFolder As Object
Public WSD As Worksheet
Public strToFolder As String
Public strDirectory As String
Public strToFileName As String
Public strArtifactName As String
Public strFromFileName As String
Public strNTSUFolder As String
Public strSPOLnetworkDrive As String
Public strSharepointAddress As String
Public strSharepointPath As String
Public intI As Integer
Public intFinalRow As Integer
Public strUser$, strPassword$, strNetworkDrive$
-----------------------------------------------------------------------------
Sub CopyFilesTo1stFolder()
strSharepointPath = "xxxxxxxxxxxxxxxxxxxxxxxx"
strNTSUFolder = Application.InputBox("Enter ATHL NTSU ID to build the folder")
If strNTSUFolder = "False" Then 'Get the starting folder
MsgBox "Nothing entered.....Good bye"
Exit Sub
End If
strNTSUFolder = Trim(strNTSUFolder) 'Remove trailing spaces'
strToFolder = "M:\NTSU Systems\ NTSU Folders\ATHL NTSU" & strNTSUFolder
strNetworkDrive = "P:"
MapNetworkDrive 'Map SharePoint Online ATHLETICS Approved Documents as Network drive P:
If Len(Dir("" & strToFolder & "", vbDirectory)) = 0 Then
MkDir strToFolder
Else
MsgBox "This folder already exists " & strToFolder
Exit Sub
End If
Set WSD = ThisWorkbook.Worksheets("Listing")
intFinalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
MsgBox "COMPLETE - Folder " & strNTSUFolder & " created in M:\NTSU Systems\ NTSU Folders\ATHL NTSU"
End Sub