We help IT Professionals succeed at work.

Check out our new AWS podcast with Certified Expert, Phil Phillips! Listen to "How to Execute a Seamless AWS Migration" on EE or on your favorite podcast platform. Listen Now

x

FileSystemObject folderexists with mapped drives VB6

grwallace
grwallace asked
on
Medium Priority
1,511 Views
Last Modified: 2012-05-07
I have the following code:-

Public Function CheckFolderExists(OrigFile As String)
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
    FolderExists = fs.FolderExists(OrigFile)
End Function
which returns the correct result for a local drive but not for a mapped drive.

Any ideas?
Comment
Watch Question

Commented:
Have you ever tried PathFileExists-function?

http://vbnet.mvps.org/index.html?code/fileapi/pathfileexists.htm

Author

Commented:
I tried it but it gives the same problme

Commented:
You could convert the mapped drive-letter to UNC:
http://support.microsoft.com/kb/192689

and then make the checks with PathFileExists again.

Author

Commented:
I tried this, and the test program returned a message stating that the drive letter was not found

Commented:
What exactly does the test app do? Could you post full&runnable code? What is the mapped drive's letter and where does it ppoint to? Please provide these information.

Author

Commented:
The mapped drive letter is t:

The problem appears to be Vista specific, as it works fine on XP machines.
If you are not using Vista then you will be unable to replicate the problem. That is what I have worked out over the past hour!

Commented:
I have Vista here. If you paste the code of your sample app, I could help to answer you question quickly or fix it accordingly.

Author

Commented:
I tried running the application created by the code from the link which you gave me before:-
http://support.microsoft.com/kb/192689
and it returns not found on Vista.

If you create a new VB progect and add 2 commandbuttons and paste in the following code, but with local & network folders which exist on your machine that is what I a doing


Option Explicit

Dim OrigFile As String, FolderExists As Boolean
Private Sub Command1_Click()
    OrigFile = "c:\comtass\progs"
    CheckFolderExists OrigFile
   
   
End Sub
Private Sub Command2_Click()
    OrigFile = "t:\comtass\progs"
    CheckFolderExists OrigFile
End Sub
Public Function CheckFolderExists(OrigFile As String)
' Add the Microsoft Scripting Runtime reference if this causes a problem
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
    FolderExists = fs.FolderExists(OrigFile)
     If FolderExists = True Then
        MsgBox OrigFile & " Exists"
    Else
        MsgBox OrigFile & " Does Not Exist"
    End If
End Function

Commented:
Well, for me PathFileExists as mentioned in my first comment does work under vista! Here my Code:
Public Class Form1
 
    Dim OrigFile As String, FolderExists As Boolean
 
    Private Declare Function PathFileExists Lib "shlwapi" _
   Alias "PathFileExistsA" _
  (ByVal pszPath As String) As Long
 
    Public Function CheckFolderExists(ByVal OrigFile As String)
        ' Add the Microsoft Scripting Runtime reference if this causes a problem
        Dim fs
        fs = CreateObject("Scripting.FileSystemObject")
        'FolderExists = fs.FolderExists(OrigFile)
        FolderExists = PathFileExists(OrigFile)
 
        If FolderExists = True Then
            MsgBox(OrigFile & " Exists")
        Else
            MsgBox(OrigFile & " Does Not Exist")
        End If
    End Function
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        OrigFile = "c:\test"
        CheckFolderExists(OrigFile)
    End Sub
 
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        OrigFile = "z:\test\mgm\"
        CheckFolderExists(OrigFile)
    End Sub
End Class

Open in new window

Commented:
WAIT...it always returns exists...  :/
let me see again!

Commented:
THIS works (for me):

 
Public Class Form1
 
    Dim OrigFile As String, FolderExists As Long, test As Integer
 
    Private Declare Function PathFileExists Lib "shlwapi" _
   Alias "PathFileExistsA" _
  (ByVal pszPath As String) As Long
 
    Public Function CheckFolderExists(ByVal OrigFile As String)
        ' Add the Microsoft Scripting Runtime reference if this causes a problem
        Dim fs
        fs = CreateObject("Scripting.FileSystemObject")
        'FolderExists = fs.FolderExists(OrigFile)
 
        FolderExists = PathFileExists(OrigFile)
        test = (FolderExists Mod 2)
 
        If test = 1 Then
            MsgBox(OrigFile & " Exists")
        Else
            MsgBox(OrigFile & " Does Not Exist")
        End If
    End Function
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        OrigFile = "c:\test\mgm"
        CheckFolderExists(OrigFile)
    End Sub
 
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        OrigFile = "z:\test\mgm"
        CheckFolderExists(OrigFile)
    End Sub
End Class

Open in new window

Author

Commented:
yes, but my program is a VB6 program and not a VB.Net program.

I tried this in VB6 by changing the click events and adding the scripting runtime reference but it doe not run
I do appreciate your effort though

Commented:
> but it doe not run
Tell me which error occurs, please.

Author

Commented:
I get a runtime error 438 - item dosen't support this property or method in the

fs = CreateObject("Scripting.FileSystemObject")

line

Commented:
SOLUTION: regist the scrrun.dll start -> run -> regsvr32 c:\windows\system32\scrrun.dll scrrun.dll may be under different folder.

Author

Commented:
When I tried to do this I got the message:-

the module "C:\WINDOWS|SYSTEM32\SCRRUN.DLL" was loaded but the call to DllRegisterServer failed with error code 0z80004005

Commented:
Did you run it as Administrator?

0x80004005 denotes "Access is denied" error. See if running the Regsvr32 command-line from an elevated Command Prompt helps

Author

Commented:
Running as an administer did succeed, but the problme with the program persists

Commented:
Wait a minute:

>I get a runtime error 438 - item dosen't support this property or method in the
>fs = CreateObject("Scripting.FileSystemObject")
>line
This is'n used anymore in the code I gave you! I used the PathFileExists function declared in shlwapi.dll. The error must be somewhere else! Forget about the regsvr32 procedure and try again this code:

Public Class Form1
 
    Dim OrigFile As String, FolderExists As Long, test As Integer
 
    Private Declare Function PathFileExists Lib "shlwapi" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
 
    Public Sub CheckFolderExists(ByVal OrigFile As String)
        ' Add the Microsoft Scripting Runtime reference if this causes a problem
        'Dim fs
        'fs = CreateObject("Scripting.FileSystemObject")
        'FolderExists = fs.FolderExists(OrigFile)
 
        FolderExists = PathFileExists(OrigFile)
        test = (FolderExists Mod 2)
 
        If test = 1 Then
            MsgBox(OrigFile & " Exists")
        Else
            MsgBox(OrigFile & " Does Not Exist")
        End If
    End Sub
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        OrigFile = "c:\test\mgm"
        CheckFolderExists(OrigFile)
    End Sub
 
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        OrigFile = "G:\Software\Treiber\Intel S3210"
        CheckFolderExists(OrigFile)
    End Sub
End Class

Open in new window

Author

Commented:
THe original problem persists I'm afraid

If you look  at the atttached screenshot you will command prompt window in the folder which the program says doesn't exist

Clip2.jpg

Commented:
That's sad...did you try the method using unc as proposed in my second comment?

Copy this in a new vb6 form and add a button1
      Option Explicit
 
      Private Const RESOURCETYPE_ANY = &H0
      Private Const RESOURCE_CONNECTED = &H1
 
      Private Type NETRESOURCE
         dwScope As Long
         dwType As Long
         dwDisplayType As Long
         dwUsage As Long
         lpLocalName As Long
         lpRemoteName As Long
         lpComment As Long
         lpProvider As Long
      End Type
 
      Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias _
         "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, _
         ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) _
         As Long
 
      Private Declare Function WNetEnumResource Lib "mpr.dll" Alias _
         "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, _
         lpBuffer As Any, lpBufferSize As Long) As Long
 
      Private Declare Function WNetCloseEnum Lib "mpr.dll" ( _
         ByVal hEnum As Long) As Long
 
      Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
         (ByVal lpString As Any) As Long
 
      Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
         (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
         
            Private Declare Function PathFileExists Lib "shlwapi" _
   Alias "PathFileExistsA" _
  (ByVal pszPath As String) As Long
 
 
 
 
      Private Sub Command1_Click()
        Dim path, letter, rest, unc, newpath As String
        
      
        
        path = "t:\comtass\progs"        '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        letter = Mid(path, 1, 2)
        rest = Mid(path, 3)
      
        unc = LetterToUNC(letter)
        newpath = unc & rest
        
        CheckFolderExists (newpath)
 
      End Sub
      
      
      
Public Function CheckFolderExists(OrigFile As String)
' Add the Microsoft Scripting Runtime reference if this causes a problem
    Dim fs
    Dim FolderExists As Boolean
    
    'method 1
    Set fs = CreateObject("Scripting.FileSystemObject")
    FolderExists = fs.FolderExists(OrigFile)
     If FolderExists = True Then
        MsgBox OrigFile & " Exists"
    Else
        MsgBox OrigFile & " Does Not Exist"
    End If
    
    'method 2
    FolderExists = PathFileExists(OrigFile)
 
    If FolderExists = True Then
        MsgBox (OrigFile & " Exists")
    Else
        MsgBox (OrigFile & " Does Not Exist")
    End If
   
    
End Function
 
 
      Function LetterToUNC(ByVal DriveLetter As String) As String
         Dim hEnum As Long
         Dim NetInfo(1023) As NETRESOURCE
         Dim entries As Long
         Dim nStatus As Long
         Dim LocalName As String
         Dim UNCName As String
         Dim i As Long
         Dim r As Long
 
         ' Begin the enumeration
         nStatus = WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, _
            0&, ByVal 0&, hEnum)
 
         LetterToUNC = "Drive Letter Not Found"
 
         'Check for success from open enum
         If ((nStatus = 0) And (hEnum <> 0)) Then
            ' Set number of entries
            entries = 1024
 
            ' Enumerate the resource
            nStatus = WNetEnumResource(hEnum, entries, NetInfo(0), _
               CLng(Len(NetInfo(0))) * 1024)
 
            ' Check for success
            If nStatus = 0 Then
               For i = 0 To entries - 1
                  ' Get the local name
                  LocalName = ""
                  If NetInfo(i).lpLocalName <> 0 Then
                     LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1)
                     r = lstrcpy(LocalName, NetInfo(i).lpLocalName)
                  End If
 
                  ' Strip null character from end
                  If Len(LocalName) <> 0 Then
                     LocalName = Left(LocalName, (Len(LocalName) - 1))
                  End If
 
                  If UCase$(LocalName) = UCase$(DriveLetter) Then
                     ' Get the remote name
                     UNCName = ""
                     If NetInfo(i).lpRemoteName <> 0 Then
                        UNCName = Space(lstrlen(NetInfo(i).lpRemoteName) _
                           + 1)
                        r = lstrcpy(UNCName, NetInfo(i).lpRemoteName)
                     End If
 
                     ' Strip null character from end
                     If Len(UNCName) <> 0 Then
                        UNCName = Left(UNCName, (Len(UNCName) _
                           - 1))
                     End If
 
                     ' Return the UNC path to drive
                     LetterToUNC = UNCName
 
                     ' Exit the loop
                     Exit For
                  End If
               Next i
            End If
         End If
 
         ' End enumeration
         nStatus = WNetCloseEnum(hEnum)
      End Function

Open in new window

Author

Commented:
Unfortunately this returns:-

drive letter not found\comtass\progs Does Not Exist

Commented:
Unlock this solution with a free trial preview.
(No credit card required)
Get Preview

Author

Commented:
Hi,
I am using Vista Home Premium, and I am logging in to the server as Administrator.

I now have to leave to go on vacation for a couple of weeks, but I am sure that I will be able to do something with your last example.

Thanks a lot  and  10 out of 10 for you efforts
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a free trial preview!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.