Find a Database???

[ande211]

Hi all,

I was womdering if someone could show me how to tell my
program where to go look for my database. For example I
have a program that I run from my C: drive. How do I tell
the program to go look for the database that is sitting on
a network drive. Some code for this would greatly be appreciated.

Tahnks All

[reeset]

I'll give the the first part right now. But I'm on my way out the door, so if no body has answered you by this evening, I will finish my thought. The first thing that I will assume, is that you don't know what the Drive letter will always be, but do know the network path. So here we will look for the Network Drive letter. The easiest way to do this is through the FileSystemObject, but can be done through the API, just a bit longer, but I could get if for you if that is what you would rather have. Anyway, here is the first part. This will look for the UNC path, and match it with its drive letter.

Private Sub Command1_Click()
  Dim fso, d, dc, s, n, sPath
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set dc = fso.Drives
  For Each d In dc
    s = d.DriveLetter
   
   'It the Drive does not have a sharename, then sPath is
   'blank, and skipped.
   
    sPath = UCase(d.ShareName)
    
    If sPath = "\\CSP2\SPACE\IS" Then
      MsgBox d.DriveLetter
        
    End If
    
    

  Next

End Sub

I will post the rest of this, (the FindFirstFile/FindNextFile) stuff later if not body else does.

[reeset]

Sorry I didn't do this post haste, but I'm pretty sure that this will work. Since I'm not on a network right now, I can't test it, but I know the findfiles works, so I will assume the rest does as well. Anyway, this assumes that there is only one file with the name that you are looking for on the Drive (unless you wish to specify a directory)

Anyway, here you go.

'****************This goes in a module****************

Declare Function FindFirstFile Lib "kernel32" Alias _
   "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _
   As WIN32_FIND_DATA) As Long

   Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
   (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

   Declare Function GetFileAttributes Lib "kernel32" Alias _
   "GetFileAttributesA" (ByVal lpFileName As String) As Long

   Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) _
   As Long


   Public Const MAX_PATH = 260
   Public Const MAXDWORD = &HFFFF
   Public Const INVALID_HANDLE_VALUE = -1
   Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
   Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
   Public Const FILE_ATTRIBUTE_HIDDEN = &H2
   Public Const FILE_ATTRIBUTE_NORMAL = &H80
   Public Const FILE_ATTRIBUTE_READONLY = &H1
   Public Const FILE_ATTRIBUTE_SYSTEM = &H4
   Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

   Type FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
   End Type

   Type WIN32_FIND_DATA
     dwFileAttributes As Long
     ftCreationTime As FILETIME
     ftLastAccessTime As FILETIME
     ftLastWriteTime As FILETIME
     nFileSizeHigh As Long
     nFileSizeLow As Long
     dwReserved0 As Long
     dwReserved1 As Long
     cFileName As String * MAX_PATH
     cAlternate As String * 14
   End Type

 

 Public Function StripNulls(OriginalStr As String) As String
      If (InStr(OriginalStr, Chr(0)) > 0) Then
         OriginalStr = Left(OriginalStr, _
          InStr(OriginalStr, Chr(0)) - 1)
      End If
      StripNulls = OriginalStr
 End Function

'***************End of Module**********************

And put this code in a form. (It assumes that you have
one command button named Command1 and a textbox to tell you
what file you are looking for.)

'*****************In Form******************************

Option Explicit
Private iniPath As String

   Function FindDIR(path As String, SearchStr As String)
   Dim FileName As String
   Dim DirName As String
   Dim dirNames() As String
   Dim nDir As Integer
   Dim i As Integer
   Dim hSearch As Long
   Dim WFD As WIN32_FIND_DATA
   Dim Cont As Integer
   Dim FT As FILETIME
   Dim DateCStr As String, DateMStr As String
     
   If Right(path, 1) <> "\" Then path = path & "\"
   
   nDir = 0
   ReDim dirNames(nDir)
   Cont = True
   hSearch = FindFirstFile(path & "*", WFD)
   If hSearch <> INVALID_HANDLE_VALUE Then
      Do While Cont
         DirName = StripNulls(WFD.cFileName)
         
         If (DirName <> ".") And (DirName <> "..") Then
            
            If GetFileAttributes(path & DirName) And _
             FILE_ATTRIBUTE_DIRECTORY Then
               dirNames(nDir) = DirName
               nDir = nDir + 1
               ReDim Preserve dirNames(nDir)
               
            End If
         End If
         Cont = FindNextFile(hSearch, WFD)
         DoEvents
      Loop
      Cont = FindClose(hSearch)
   End If

   
   hSearch = FindFirstFile(path & SearchStr, WFD)
   Cont = True
   If hSearch <> INVALID_HANDLE_VALUE Then
      While Cont
         FileName = StripNulls(WFD.cFileName)
            If (FileName <> ".") And (FileName <> "..") And _
              ((GetFileAttributes(path & FileName) And _
               FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
            FindDIR = FindDIR + (WFD.nFileSizeHigh * _
             MAXDWORD) + WFD.nFileSizeLow
            'FileCount = FileCount + 1
            DirPath = path & FileName
          End If
         Cont = FindNextFile(hSearch, WFD)
      Wend
      Cont = FindClose(hSearch)
   End If

   
    If nDir > 0 Then
      
      For i = 0 To nDir - 1
        FindDIR = FindDIR + FindDIR(path & dirNames(i) _
         & "\", SearchStr)
      Next i
   End If
   End Function

   Private Sub Command1_Click()
   Dim sSource As String, sFind As String
   Dim lret As Long
   Dim sDriveletter As String
   

   Screen.MousePointer = vbHourglass
   
   lret = GETUNC(sDriveletter)
   sSource = sDriveletter & ":\"
   sFind = Text1.Text
   lret = FindDIR(sSource, sFind)
   MsgBox DirPath
   
   Screen.MousePointer = vbDefault
   End Sub

 Private Property Get DirPath() As String
 DirPath = iniPath
 End Property
 Private Property Let DirPath(ByVal iniNewValue As String)
 iniPath = iniNewValue
 End Property
 
 Private Function GETUNC(Driveletter As String) As Integer
  Dim fso, d, dc, s, n, sPath
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set dc = fso.Drives
  For Each d In dc
    s = d.Driveletter
   
   'It the Drive does not have a sharename, then sPath is
   'blank, and skipped.
   
    sPath = UCase(d.ShareName)
     
    'Change this to the network path that you are interested
    'in.

    If sPath = "\\CSP2\SPACE\IS" Then
      Driveletter = d.Driveletter
      GETUNC = 1
      Exit For
    End If
    
    

  Next

End Function

Anyway, I hope this gets you started.