Go Back   Access World Forums > Microsoft Access Reference > Code Repository

 
Reply
 
Thread Tools Rate Thread Display Modes
Old 01-08-2016, 06:32 PM   #1
speakers_86
I am jack's comment.
 
speakers_86's Avatar
 
Join Date: May 2007
Location: JBLM, Wa
Posts: 1,919
Thanks: 11
Thanked 158 Times in 119 Posts
speakers_86 will become famous soon enough
Test Write Access to Backend Path

This will test all backend path locations for write access. If write access is denied or the medium is unplugged, there will be an error. It does not in any way relink tables. This is intended to be done before checking the table links, just to make sure the permissions are correct. If the path cannot be written to, you may exit gracefully.

Code:
Option Compare Database
Option Explicit

Public Function BackendPathsAvailable(Optional booErrorOnAllBrokenLinks As Boolean = True) As Boolean
    On Error GoTo err

    Dim strPath As String
    Dim booResult As Boolean
    
    booResult = True
    
    Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("SELECT MSysObjects.Database FROM MSysObjects GROUP BY MSysObjects.Database HAVING (((MSysObjects.Database) Is Not Null)); ")
    
    If rst.RecordCount <> 0 Then
        rst.MoveFirst
        While Not rst.EOF
            strPath = Left(rst!Database, Len(rst!Database) - Len(GetFilenameFromPath(rst!Database)))
            If TestPath(strPath, booErrorOnAllBrokenLinks) = False Then booResult = False
            rst.MoveNext
        Wend
    End If
    
    rst.Close
    Set rst = Nothing
    
    BackendPathsAvailable = booResult

    Exit Function
err:
    Debug.Print err.Description
End Function


Private Function TestPath(strPath As String, booError As Boolean) As Boolean
    On Error GoTo err
    
    Dim fso As Object
    Dim obj As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set obj = fso.CreateTextFile(strPath & "\path testing delete me.txt", True)
    obj.WriteLine ("This file is only a test.  It can be deleted safely.")
    obj.Close
    
    TestPath = True
    TryDeleteFile strPath
    Exit Function
err:
    If booError Then MsgBox "There was an error finding the following path: " & vbCrLf & strPath & vbCrLf & vbCrLf & err.Number & ": " & err.Description
End Function

Private Sub TryDeleteFile(strPath As String)
    On Error Resume Next
    Kill strPath & "\path testing delete me.txt"
End Sub


Function GetFilenameFromPath(ByVal strPath As String) As String
' Returns the rightmost characters of a string upto but not including the rightmost '\'
' e.g. 'c:\winnt\win.ini' returns 'win.ini'

    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

__________________
If you look, you can find anything.
Google is your friend.

To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.


~~~~~~~~~~~~~~~~~~~~~~~~~~~
Access 2010 screw this! I went back to 2007
Windows 7
speakers_86 is offline   Reply With Quote
The Following User Says Thank You to speakers_86 For This Useful Post:
hassanogaibi (06-28-2016)
Reply

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
How Test DROP Table in Access Backend giovanniroi Modules & VBA 6 01-11-2011 09:44 AM
Path of Backend Tsango General 2 05-26-2006 01:29 AM
Backend path instead of frontend path? pat_nospam General 4 06-14-2004 07:50 AM
Get backend path for FileCopy Rachael General 9 09-06-2003 04:18 AM
Path to Backend. Oldsoftboss Modules & VBA 1 02-06-2003 04:19 AM




All times are GMT -8. The time now is 07:33 AM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Featured Forum post


Sponsored Links


Powered by vBulletin®
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World