How to use UNC with pushd in vba

[FuzMic]

Hi buddies

i was trying to run Shell("pushd \\sharedfolder-in-network") but it fail to push even if i wait. Net Use Z: \\sharefolder also won't work.

How can i can change an UNC to a drive in VBA so that i can do some file system action with shell eg with unzip.exe

Appreciate some lights!

 

[arnelgp]

here is a code found somewhere to Map and UnMap.

Option Compare Database
Option Explicit

'**********************************************
'
' arnelgp
'
' taken from somewhere from the net
'
'*********************************************

Private Const CONNECT_UPDATE_PROFILE = &H1
Private Const RESOURCE_CONNECTED As Long = &H1&
Private Const RESOURCE_GLOBALNET As Long = &H2&
Private Const RESOURCETYPE_DISK As Long = &H1&
Private Const RESOURCEDISPLAYTYPE_SHARE& = &H3
Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1&
 
#If VBA7 Then
    Private Declare PtrSafe Function WNetCancelConnection2 Lib "mpr.dll" _
      Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
     
    Private Declare PtrSafe Function WNetAddConnection2 Lib "mpr.dll" _
      Alias "WNetAddConnection2A" (lpNetResource As NETCONNECT, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
#Else
    Private Declare Function WNetCancelConnection2 Lib "mpr.dll" _
      Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
     
    Private Declare Function WNetAddConnection2 Lib "mpr.dll" _
      Alias "WNetAddConnection2A" (lpNetResource As NETCONNECT, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
#End If
Private Type NETCONNECT
  dwScope As Long
  dwType As Long
  dwDisplayType As Long
  dwUsage As Long
  lpLocalName As String
  lpRemoteName As String
  lpComment As String
  lpProvider As String
End Type
 
' arnelgp
'
' taken from somewhere in the net
'
Public Function MapDrive(LocalDrive As String, _
                         RemoteDrive As String, _
                         Optional username As String, _
                         Optional password As String) As Boolean
 
' Example:
' MapDrive "Q:", "\\RemoteMachine\RemoteDirectory", "MyLoginName", "MyPassword"
'
' if there is no password on the UNC drive:
'
' MapDrive "Q:", "\\RemoteMachine\RemoteDirectory"
'
  Dim NetR As NETCONNECT
 
  NetR.dwScope = RESOURCE_GLOBALNET
  NetR.dwType = RESOURCETYPE_DISK
  NetR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
  NetR.dwUsage = RESOURCEUSAGE_CONNECTABLE
  NetR.lpLocalName = Left(LocalDrive, 1) & ":"
  NetR.lpRemoteName = RemoteDrive
 
  MapDrive = (WNetAddConnection2(NetR, username, password, _
    CONNECT_UPDATE_PROFILE) = 0)
 
End Function
 
Public Function UnMapDrive(LocalDrive As String) As Boolean
 
' Example:
' UnMapDrive "Q:"
 
  Dim NetR As NETCONNECT
 
  NetR.dwScope = RESOURCE_GLOBALNET
  NetR.dwType = RESOURCETYPE_DISK
  NetR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
  NetR.dwUsage = RESOURCEUSAGE_CONNECTABLE
  NetR.lpLocalName = Left(LocalDrive, 1) & ":"
  NetR.lpRemoteName = ""
 
  UnMapDrive = (WNetCancelConnection2(LocalDrive, _
    CONNECT_UPDATE_PROFILE, False) = 0)
 
End Function

 

[FuzMic]

Thats quick friend, will tinker with it. Thanks

But do you know why we can't pushd in VBA.

 

[arnelgp]

Pushd and popd are internal command. You cant shell from it.

 

[arnelgp]

if you need to change dir, execute, then
go back to folder before, you need to create
a function or sub. something like this.

Public Function fPushD(Byval FolderToGo As String)
Dim thisFolder As String
If Dir(FolderToGo, vbDirectory) <> "" Then
' save the current folder
ThisFolder = CurDir
' change folder
ChDir FolderToGo
' what action do you need to do
' do it here
'.....
'
' after done, goback to orig folder
ChDir thisFolder
Else
MsgBox "Folder {" & FolderToGo & "} can't be found"
End If
End Sub

 

[FuzMic]

Friend you are right about internal command. The chdir does not work on UNC, true?

 

[arnelgp]

Im not sure, i am not on a lan right now. But i think it will.