Printable View
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
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.
I will post the rest of this, (the FindFirstFile/FindNextFile) stuff later if not body else does.Code:
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
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.
Code:
'****************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.)
Anyway, I hope this gets you started.Code:
'*****************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