I've never posted code here before, but I suspect that it may not come out
formatted as required. If you want a text file of the code email me at
(e-mail address removed) (domain = live), I'm don't have a webspace to post at.
To check for Logical Drive Exist:
'CODE START
'
http://www.devx.com/vb2themax/Tip/19002
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
' Check whether a given drive exist
' Note that this returns True even if the drive isn't currently ready
' (e.g. a diskette isn't in drive A
Function DriveExists(ByVal sDrive As String) As Boolean
Dim buffer As String
buffer = Space(64)
' return False if invalid argument
If Len(sDrive) = 0 Then Exit Function
'get the string that contains all drives
GetLogicalDriveStrings Len(buffer), buffer
' check that the letter we're looking for is there
DriveExists = InStr(1, buffer, Left$(sDrive, 1), vbTextCompare)
End Function
'CODE END
Check if a file exists:
'CODE START
'=====================================================
' Returns True if the file exists, False if not
'=====================================================
'ErrStrN
Public Function FileExist(strFilepath As String) As Boolean
On Error Resume Next
Dim blnResult As Boolean
blnResult = False
'=========================
Dim i As Integer
'=========================
i = GetAttr(strFilepath)
Select Case Err.Number
Case 0
blnResult = True
Case Else
blnResult = False
End Select
'=========================
FileExist = blnResult
End Function
'CODE END
Check if File Is Locked:
'CODE START
'=====================================================
' From Microsoft KB - Article Unknown
'=====================================================
'ErrStrN
Public Function FileLocked(strFileName As String) As Boolean
On Error Resume Next
' If the file is already opened by another process,
' and the specified type of access is not allowed,
' the Open operation fails and an error occurs.
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
' If an error occurs, the document is currently open.
If Err.Number <> 0 Then
' Display the error number and description.
'MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
FileLocked = True
Err.Clear
End If
End Function
'CODE END
And if you're feeling froggy, heres a function I use to initialize a file
for operation (verifies existance, optionally creates new file if it doesn't
exist, checks for locked file, waits specified time for file to be unlocked.
ignoreerrors argument is in there for use with error logging procedures (to
avoid infinate loop) and can probably be disregarded competely). All this
code can go in one module. InitFileOp uses the examples above, so if you are
going to use it, be sure to include the above code.
Also, error handling is specific to my global handler... will need to change.
'CODE START
'Sleep Timer Increment for InitFileOp()
Public Const INITFILEOP_SLEEPTIME As Long = 125
'==================
'APIs
'
'Declare Sleep Sub
Public Declare Sub Sleep _
Lib "kernel32" ( _
ByVal dwMilliseconds As Long _
)
'==============================================================================
' Waits for a file to be unlocked before returning a value
' Args:
' aFile - string -Pathname of File to Validate
' aMilliseconds - long - Time to wait for file to unlock
' aCreateFile - boolean - Create the file if it doesnt exist
' aIgnoreErrors - boolean - Sets On Error Resume Next if true (for
' use when calling from xHandler to avoid error looping)
'
' Returns:
' 0 - System Error
' 1 - File Ready
' 2 - Doesn't Exist
' 3 - Cant Create
' 4 - File Locked
'
' Uses Sleep(125) as check interval (1/8 second) (ref Sleep API)
'==============================================================================
'ErrStrV1.00
'IgnoreErrors = True sets On Error GoTo Exit_InitFileOp
Public Function InitFileOp( _
aFile As String, _
Optional aMilliseconds As Long = 2000, _
Optional aCreateFile As Boolean = False, _
Optional aIgnoreErrors As Boolean = False _
) As Integer
On Error GoTo Error_InitFileOp
Dim xMsg As String, xBtns As Long, xTitle As String
Dim xShow As Boolean, xEvent As Long
xMsg = "": xBtns = 16: xTitle = "Error": xShow = True: xEvent = 0
Dim intRet As Integer
'=========================
Dim blnCreateFile As Boolean 'aCreateFile
Dim blnIgnoreErrors As Boolean 'aIgnoreErrors
Dim lngElapsedTime As Long 'Elapsed Milliseconds
Dim lngWaitFor As Long 'aMilliseconds
Dim strFile As String 'aFile
'=========================
'Initialize
intRet = 0
blnIgnoreErrors = IIf(IsMissing(aIgnoreErrors), False, aIgnoreErrors)
'If calling from error handler, remove error handling and end function to
'avoid error looping
If blnIgnoreErrors = True Then
On Error GoTo Exit_InitFileOp
End If
blnCreateFile = aCreateFile
lngWaitFor = aMilliseconds
lngElapsedTime = 0
strFile = aFile
'Check for file and create one if instructed
If (FileExist(strFile) = False) And (blnCreateFile = True) Then
'Check Directory, create if it doesnt exist
If Dir(GetFileDir(strFile)) = "" Then
On Error Resume Next
MkDir GetFileDir(strFile)
If Err.Number = 75 Then
Err.Clear
ElseIf Err.Number <> 0 Then
On Error GoTo Error_InitFileOp
Err.Raise CUSTERR + 1008, , ERR_DESC_1008, "", 0
End If
End If
'Create file
On Error Resume Next
Open strFile For Append As FreeFile 'Create the file
'If an error ocurred creating the file...
If Err.Number <> 0 Then
'Clear Error and return InitFileOp = 3
Err.Clear
intRet = 3
GoTo Exit_InitFileOp
End If
On Error GoTo Error_InitFileOp 'Reset Err Handler
Close #FreeFile 'Close the file
End If
'If the file doesn't exist and its supposed to...
If (FileExist(strFile) = False) And (blnCreateFile = False) Then
intRet = 2
GoTo Exit_InitFileOp
End If
'Wait the specified amount of time if the file is locked
While (lngElapsedTime < lngWaitFor) And (FileLocked(strFile) = True)
lngElapsedTime = lngElapsedTime + INITFILEOP_SLEEPTIME
Sleep (INITFILEOP_SLEEPTIME)
Wend
'If the file's still locked...
If FileLocked(strFile) = True Then
intRet = 4
GoTo Exit_InitFileOp
End If
'File OK
intRet = 1
'=========================
Exit_InitFileOp:
InitFileOp = intRet
Exit Function
Error_InitFileOp:
xHandler Err.Number, Err.Description, _
"mod_sFileOps", "InitFileOp", _
xMsg, xBtns, xTitle, xShow, xEvent
Resume Exit_InitFileOp
Resume
End Function
'CODE END
Hope this helps...
-jack