Wrox Programmer Forums

Need to download code?

View our list of code downloads.

Go Back   Wrox Programmer Forums > Microsoft Office > Access and Access VBA > Access VBA
Password Reminder
Register
| FAQ | Members List | Calendar | Search | Today's Posts | Mark Forums Read
Access VBA Discuss using VBA for Access programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of tens of thousands of software programmers and website developers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining today you can post your own programming questions, respond to other developers’ questions, and eliminate the ads that are displayed to guests. Registration is fast, simple and absolutely free .
DRM-free e-books 300x50
Reply
 
Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old May 5th, 2004, 10:46 AM
Friend of Wrox
Points: 4,007, Level: 26
Points: 4,007, Level: 26 Points: 4,007, Level: 26 Points: 4,007, Level: 26
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Jun 2003
Location: Lansing, Michigan, USA.
Posts: 1,151
Thanks: 2
Thanked 14 Times in 14 Posts
Send a message via ICQ to SerranoG Send a message via AIM to SerranoG
Default Opening Files Read-Only

If I use the shell command to open files, I would like to automatically open them read-only. There used to be a switch that opened a file that way, e.g. "/r", but I find Windows XP doesn't have this switch. Is there some way I can use the shell command (or another way) that would always open a file read-only? The files can be Word, Excel, etc.


Greg Serrano
Michigan Dept. of Environmental Quality, Air Quality Division
__________________
Greg Serrano
Michigan Dept. of Environmental Quality
Air Quality Division
Reply With Quote
  #2 (permalink)  
Old May 5th, 2004, 02:36 PM
sal sal is offline
Friend of Wrox
 
Join Date: Oct 2003
Location: Clarksville, TN, USA.
Posts: 702
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Try setting the file properties as read-only by right clicking on the file.

Would that work?



Sal
Reply With Quote
  #3 (permalink)  
Old May 5th, 2004, 02:54 PM
Friend of Wrox
Points: 4,007, Level: 26
Points: 4,007, Level: 26 Points: 4,007, Level: 26 Points: 4,007, Level: 26
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Jun 2003
Location: Lansing, Michigan, USA.
Posts: 1,151
Thanks: 2
Thanked 14 Times in 14 Posts
Send a message via ICQ to SerranoG Send a message via AIM to SerranoG
Default

I don't want to give that person the power to choose. Right-clicking shouldn't be an option. They must click a command button which opens the file read-only.

Here's what I have so far thanks to another Forum. It works partially.
Code:
    Dim objDOC As New Word.Application
    Dim objMDB As New Access.Application
    Dim objPPT As New PowerPoint.Application
    Dim objXLS As New Excel.Application

    Select Case Right(Me.txtApplication, 4)
        Case "Word"
            objDOC.Documents.Open Me.txtFileInfo, , True
            objDOC.Visible = True
            Set objDOC = Nothing
        Case "cess"
            objMDB.DBEngine.OpenDatabase Me.txtFileInfo, , True
            objMDB.Visible = True
            Set objMDB = Nothing
        Case "oint"
            objPPT.Presentations.Open Me.txtFileInfo, msoTrue
            objPPT.Visible = msoTrue
            Set objPPT = Nothing
        Case "xcel"
            objXLS.Workbooks.Open Me.txtFileInfo, , True
            objXLS.Visible = True
            Set objXLS = Nothing
        Case Else
            Application.FollowHyperlink Me.txtFileInfo
    End Select

Problem: The Excel one works. The cases for Word, PowerPoint, and Access do not. It seems that the .Workbooks equivalent for the others are NOT what I put there, i.e. .Documents, .Presentations, and .DBEngine are wrong.

The CASE ELSE situation will open a file, but not read-only. I can only do it for MS Office documents so far. I have no idea what the .Open equivalent of other programs would look like.

I do have all necessary libraries referenced. What are the correct collection names? I did find it odd that PowerPoint collections insist use of this "msoTrue" variable instead of a plain True.


Greg Serrano
Michigan Dept. of Environmental Quality, Air Quality Division
Reply With Quote
  #4 (permalink)  
Old May 6th, 2004, 05:28 AM
Friend of Wrox
 
Join Date: Jun 2003
Location: Oxford, , United Kingdom.
Posts: 120
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Greg

Can you use the MS Scripting runtime library? If so, I can send you a class module that should allow you to open any file in read only mode.


Brian Skelton
Braxis Computer Services Ltd.
Reply With Quote
  #5 (permalink)  
Old May 6th, 2004, 06:56 AM
Friend of Wrox
Points: 4,007, Level: 26
Points: 4,007, Level: 26 Points: 4,007, Level: 26 Points: 4,007, Level: 26
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Jun 2003
Location: Lansing, Michigan, USA.
Posts: 1,151
Thanks: 2
Thanked 14 Times in 14 Posts
Send a message via ICQ to SerranoG Send a message via AIM to SerranoG
Default

Quote:
quote:Originally posted by Braxis
Can you use the MS Scripting runtime library?
Yes, I can.

Quote:
quote:If so, I can send you a class module that should allow you to open any file in read only mode.
Much appreciated, Brian.

Greg Serrano
Michigan Dept. of Environmental Quality, Air Quality Division
Reply With Quote
  #6 (permalink)  
Old May 6th, 2004, 02:40 PM
Friend of Wrox
 
Join Date: Jun 2003
Location: Oxford, , United Kingdom.
Posts: 120
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Greg

Stick the following in a new class module:
Code:
Option Compare Database
Option Explicit

Private Const STARTF_USESHOWWINDOW& = &H1
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&

Private Const WIN_NORMAL = 1
Private Const WIN_MIN = 2
Private Const WIN_MAX = 3

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
    hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
    lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
    lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
    lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long

 Private Declare Function CloseHandle Lib "kernel32" (ByVal _
     hObject As Long) As Long

Private objFileSystem As FileSystemObject

Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal Hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&


'************ Code Start **********
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'

'***************Usage Examples***********************
'Open a folder:     ?fHandleFile("C:\TEMP\",WIN_NORMAL)
'Call Email app:    ?fHandleFile("mailto:dash10@hotmail.com",WIN_NORMAL)
'Open URL:          ?fHandleFile("http://home.att.net/~dashish", WIN_NORMAL)
'Handle Unknown extensions (call Open With Dialog):
'                   ?fHandleFile("C:\TEMP\TestThis",Win_Normal)
'Start Access instance:
'                   ?fHandleFile("I:\mdbs\CodeNStuff.mdb", Win_NORMAL)
'****************************************************

Public Function fHandleFile(stFile As String, lShowHow As Long)
Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)

    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function
'************ Code End **********


Private Sub Class_Initialize()

    Set objFileSystem = New FileSystemObject

End Sub


Public Function FileExists(strFilePath As String) As Boolean
' Comments  :
' Parameters: strFilePath -
' Returns   : Boolean -
' Modified  :
'
' --------------------------------------------------
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim objFolder As Folder

    If objFileSystem.FileExists(strFilePath) Then
        FileExists = True
    Else
        FileExists = False
    End If

    'TVCodeTools ErrorHandlerStart
PROC_EXIT:
    Exit Function

PROC_ERR:
    MsgBox Err.Description & " " & "mdlFiles1" & ":" & "CreateFolder"
    FileExists = False
    Resume PROC_EXIT
    'TVCodeTools ErrorHandlerEnd

End Function
Private Sub Class_Terminate()

    Set objFileSystem = Nothing

End Sub


Public Function SetFileAtt(strFilePath As String, intAttr As FileAttribute, bolSet As Boolean) As Boolean
' Comments  : Returns the value of the attribute before any changes are applied
' Parameters: strFilePath
'             intAttr
'             bolSet -
' Returns   : Boolean -
' Modified  :
'
' --------------------------------------------------
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim objFile As File

    If FileExists(strFilePath) Then
        Set objFile = objFileSystem.GetFile(strFilePath)
        SetFileAtt = objFile.Attributes And intAttr

        'Attr. is set and we want to turn it off
        If (objFile.Attributes And intAttr) And Not bolSet Then
            objFile.Attributes = objFile.Attributes - intAttr
            'Attr. is off and we want to set it
        ElseIf Not (objFile.Attributes And intAttr) And bolSet Then
            objFile.Attributes = objFile.Attributes + intAttr
        End If
    End If

    Set objFile = Nothing


    'TVCodeTools ErrorHandlerStart
PROC_EXIT:
    Exit Function

PROC_ERR:
    Err.Raise Err.Number
    'TVCodeTools ErrorHandlerEnd

End Function

Public Function GetFileAtt(strFilePath As String, intAttr As FileAttribute) As Boolean
' Comments  : Returns the value of the attribute
' Parameters: strFilePath
'             intAttr -
' Returns   : Boolean -
' Modified  :
'
' --------------------------------------------------
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim objFile As File

    If FileExists(strFilePath) Then
        Set objFile = objFileSystem.GetFile(strFilePath)
        GetFileAtt = objFile.Attributes And intAttr
    End If

    Set objFile = Nothing


    'TVCodeTools ErrorHandlerStart
PROC_EXIT:
    Exit Function

PROC_ERR:
    Err.Raise Err.Number
    'TVCodeTools ErrorHandlerEnd

End Function

Public Sub OpenFileReadOnly(strFilePath As String, lngShowHow As Long)
' Comments  :
' Parameters: strFilePath
'             lngShowHow -
' Modified  :
'
' --------------------------------------------------
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim bolReadOnly As Boolean
Dim intCount As Integer
Const cMAX_COUNT = 30000

    If FileExists(strFilePath) Then
        bolReadOnly = SetFileAtt(strFilePath, ReadOnly, True)

        fHandleFile strFilePath, lngShowHow

        'Need to build a delay in here or the attribute will be reset before the file opens
        'A count of 30000 works on my PC - a real timer would be better?
        Do Until intCount > cMAX_COUNT
            intCount = intCount + 1
        Loop

        bolReadOnly = SetFileAtt(strFilePath, ReadOnly, bolReadOnly)
    End If

'TVCodeTools ErrorHandlerStart
PROC_EXIT:
    Exit Sub

PROC_ERR:
    Err.Raise Err.Number
    'TVCodeTools ErrorHandlerEnd

End Sub
Using the method is simple
Code:
Dim objFileObject as clsFileObject

    Set objFileObject=New clsFileObject
    'strFileName is the name & path of the file to open
    'The second parameter is either 1,2 or 3 (look at the WIN_XXXX constants in the class module
    objFileObject.OpenFileReadOnly strFileName,1
    Set objFile=Nothing


I've stripped all the other code out of clsFileObject, so please let me know if I've broken it in the process.


Brian Skelton
Braxis Computer Services Ltd.
Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Opening PDF files comicghozt ASP.NET 1.0 and 1.1 Professional 11 October 23rd, 2006 04:06 AM
Opening word document read only in VB StevenVints VB How-To 1 May 3rd, 2006 09:52 AM
Please Help! Opening Multiple files jezywrap Excel VBA 3 December 19th, 2005 12:34 PM
opening files wilbur C# 1 April 20th, 2005 05:54 AM



All times are GMT -4. The time now is 10:49 PM.


Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
© 2013 John Wiley & Sons, Inc.