Connect to network folder as different user/logon?

[DocNice]

I need to know how to connect (via vba) to a networked folder on a server using a different logon (which will need to send a username and password).

Background:
I have scripted the Access db to move files on a network server. The security folks don't want to give full write access to each user for security reasons, but they have agreed to create a "service account" which will have its own username and password, that I can use to logon to the folder via Access. This way Access has folder rights, but no the actual user.

The problem is, I can't seem to find any code to do this. Can anyone point me in the right direction?

 

[jawilli1]

I did something simular to this with VB Script...maybe you can port this over to VBA

Sub MapNetworDrive
Dim objNetwork
Dim strDriveLetter
Dim strRemotePath
Dim strUserName
Dim strPassWord
strDriveLetter = "G:"
strRemotePath = "\\server\share"
Set objNetwork = CreateObject("WScript.Network")
strUserName = username.value
strPassWord = password.value
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath & "\" & strUserName, ,strUserName & "@domain", strPassWord
DataArea.InnerHTML = "The Script Has Executed Successfully!"
End Sub

Sub ExitHTA
self.close()
End Sub

 

[DocNice]

This is very very close. Thank you very much for the reply. In my particular case, I'd love to get another alternative though if anyone has one.

My problem is that some users are already mapped to the drive as read-only users. When I try to re-map them, it throws an error. Is there any way to accomplish this without mapping it as a drive? If all else fails, I may have to diconnect their mapping, connect a new one, diconnect when done and reconnect their old one. But that definitely has room for throwing errors and I'd rather not.

=================================
For reference and archive purposes, I did get this script to work for VBA. Here is the code:

Dim objNetwork
Dim strDriveLetter
Dim strRemotePath
Dim strUserName
Dim strPassWord
strDriveLetter = "G:"
strRemotePath = "\\ServerName\FolderName"
Set objNetwork = CreateObject("WScript.Network")
strUserName = "Username"
strPassWord = "Password"
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath, , strUserName, strPassWord
MsgBox "The Script Has Executed Successfully!"


For more info, look on the MSDN and search on MapNetworkDrive.

 

[DocNice]

I may have spoken too soon. Let me see if I can find a way around mapping a network drive to the same folder twice.

 

[Mutdogus]

My problem is that some users are already mapped to the drive as read-only users. When I try to re-map them, it throws an error.

You must disconnect the mapped network drive and log off the current user. Then when you log back on you have to know the path to the resource, you can't browse to it, or you will associate as the account that you are logged on with and have to do it again. This is probably why your getting an error.

If you get the code for connecting please post it as I am interested in it.

 

[Johnvandamme]

Have a good lunch with your IT people.. and try to convince them to provide access.

much easier than code above

 

[DocNice]

Here is the code I used, somewhat simplified. It checks to see if there are already connections to the target network drive, removes them, connects under a different user name, moves a file, disconnects, and reconnects the original network drive configuration.

Dim objNetwork
Dim objDrivePath
Dim fl As Scripting.FileSystemObject
Dim fArchive As Object
Dim fWIP As Object
Dim [other variables]

strDriveLetter = "K:"
strRemotePath = [file location]
Set objNetwork = CreateObject("WScript.Network")
strUserName = [user name of "Service Account" logon credentials created by IT department]
strPassWord = [password for Service Account]

'---You cannot sign on to the same network drive under different logons at the same time, so you must disconnect any existing connections---
' Check for current connections, and disconnect if mapped to the target folder
Dim strCurrentDriveMap As String
Dim strCurrentDriveLetter As String
Set objDrivePath = CreateObject("WScript.Network")
Set oDrives = objDrivePath.EnumNetworkDrives
For i = 0 To oDrives.Count - 1
If oDrives.Item(i) Like "\\networkpath\foldername*" Then
strCurrentDriveMap = oDrives.Item(i)
strCurrentDriveLetter = oDrives.Item(i - 1)
objDrivePath.RemoveNetworkDrive strCurrentDriveLetter, True, False
'MsgBox oDrives.Item(i)
'MsgBox strCurrentDriveLetter & " = " & strCurrentDriveMap
Else
End If
Next

objNetwork.MapNetworkDrive strDriveLetter, strRemotePath, False, strUserName, strPassWord

Set fl = New Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")

' Set the folder name
foldername1 = [variable]

'Set the current directory and destination directory
varCurrentDirectory = [folder location]
varNewDirectory = [folder location]

'If the destination folder does not exist, then create it
If Dir(varNewDirectory, vbDirectory) = "" Then
MkDir varNewDirectory
End If

'Set the file name
filename1 = [variable]
varOldFileName = varCurrentDirectory & filename1 & ".doc"
varNewFileName = varNewDirectory & filename1 & ".doc"
objDrivePath.RemoveNetworkDrive "K:", True, True
objNetwork.MapNetworkDrive strCurrentDriveLetter, strCurrentDriveMap, True

fl.MoveFile varOldFileName, varNewFileName

Set dbs = Nothing
Set qd = Nothing

objDrivePath.RemoveNetworkDrive "K:", True, True
'Check to see if there is a network drive that needs to be remapped
If strCurrentDriveLetter = "" Then
Else
objNetwork.MapNetworkDrive strCurrentDriveLetter, strCurrentDriveMap, True
End If
Set objDrivePath = Nothing
Set objNetwork = Nothing