' Uncomment (Remove the ' ) the two lines of code below if they are not already at the top of your Module
'Option Compare Database
'Option Explicit

Public Const SW_HIDE = 0
Public Const SW_MINIMIZE = 6
Public Const SW_RESTORE = 9
Public Const SW_SHOW = 5
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOWNORMAL = 1

Public Declare Function ShellExecute 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

Public Sub ExecuteFile(sFileName As String, sAction As String) Dim vReturn As Long 'sAction can be either "Open" or "Print". If ShellExecute(Access.hWndAccessApp, sAction, sFileName, vbNullString, "", SW_SHOWNORMAL) < 33 Then DoCmd.Beep MsgBox "File not found." End If End Sub
Function TextFileReadAll(strFilePathName) As String Const ForReading = 1 Dim FSO, f Set FSO = CreateObject("Scripting.FileSystemObject") Set f = FSO.OpenTextFile(strFilePathName, ForReading) TextFileReadAll = f.ReadAll Debug.Print TextFileReadAll f.Close Set f = Nothing Set FSO = Nothing End Function
Function ReadTextFile(strtxtFileName As String) On Error GoTo ReadTextFile_Err Dim fs As Object Dim a Dim txtline As String Set fs = CreateObject("Scripting.FileSystemObject") Set a = fs.OpenTextFile(strtxtFileName) a = a.ReadAll Debug.Print a a.Close Set a = Nothing Set fs = Nothing ReadTextFile_Exit: Exit Function ReadTextFile_Err: MsgBox Err.Description, , "ReadTextFile" Resume ReadTextFile_Exit End Function
'--------------------------------------------------------------------------------------- ' Procedure : TextNewFile ' DateTime : 3/30/2008 19:01 ' Purpose : ' Arguments :strName: The full path and file name to create '--------------------------------------------------------------------------------------- ' Sub TextNewFile() Dim cbr As CommandBar Dim MyFile As String Dim fnum As Long Dim lngCount As Long ' MyFile = "c:\" & "whateveryouwant.txt" ' Save to hardcoded folder ' MyFile = "..\" & "whateveryouwant.txt" ' Save to relative folder ' MyPath = app.Path & "/whateveryouwant.txt" Save to 'app.path folder 'set and open file for output MyFile = "C:\CMSSCmdBarsALL.txt" fnum = FreeFile() Open MyFile For Output As fnum 'write project info and then a blank line. Note the comma is required ' Write #fnum, "I wrote this" ' Write #fnum, "" 'use Print when you want the string without quotation marks ' Print #fnum, "I wrote this also" lngCount = 0 Print #fnum, "All Command Bars:" For Each cbr In CommandBars lngCount = lngCount + 1 ' Add a running count 'Print info to text file Print #fnum, lngCount & " " & cbr.Name & ", Enabled: " & cbr.Enabled Print #fnum, vbTab & "BuiltIn: " & cbr.BuiltIn & ", Visible: " & cbr.Visible Print #fnum, vbTab & "Type: " & cbr.Type & ", NameLocal: " & cbr.NameLocal Print #fnum, vbTab & "Position: " & cbr.Position & ", Protection: " & cbr.Protection Print #fnum, "" 'Debug.Print cbr.Name, cbr.Visible Next cbr Close #fnum End Sub
Sub TextFileNew() Dim cbr As CommandBar Dim MyFile As String Dim fnum As Long Dim lngCount As Long ' MyFile = "c:\" & "whateveryouwant.txt" ' Save to hardcoded folder ' MyFile = "..\" & "whateveryouwant.txt" ' Save to relative folder ' MyPath = app.Path & "/whateveryouwant.txt" Save to 'app.path folder ' set and open file for output MyFile = "C:\CMSSCmdBarsVisible.txt" fnum = FreeFile() Open MyFile For Output As fnum 'write project info and then a blank line. Note the comma is required ' Write #fnum, "I wrote this" ' Write #fnum, "" 'use Print when you want the string without quotation marks ' Print #fnum, "I wrote this also" lngCount = 0 Print #fnum, "Visible Command Bars:" For Each cbr In CommandBars If cbr.Visible = True Then lngCount = lngCount + 1 ' Add a running count 'Print info to text file Print #fnum, lngCount & " " & cbr.Name & ", Enabled: " & cbr.Enabled Print #fnum, vbTab & "BuiltIn: " & cbr.BuiltIn & ", Visible: " & cbr.Visible Print #fnum, vbTab & "Type: " & cbr.Type & ", NameLocal: " & cbr.NameLocal Print #fnum, vbTab & "Position: " & cbr.Position & ", Protection: " & cbr.Protection Print #fnum, "" 'Debug.Print cbr.Name, cbr.Visible End If Next cbr Close #fnum End Sub
Sub TextFileMake() Dim cbr As CommandBar Dim MyFile As String Dim fnum As Long Dim lngCount As Long ' MyFile = "c:\" & "whateveryouwant.txt" ' Save to hardcoded folder ' MyFile = "..\" & "whateveryouwant.txt" ' Save to relative folder ' MyPath = app.Path & "/whateveryouwant.txt" Save to 'app.path folder 'set and open file for output MyFile = "C:\CMSSCmdBarsEnabled.txt" fnum = FreeFile() Open MyFile For Output As fnum 'write project info and then a blank line. Note the comma is required ' Write #fnum, "I wrote this" ' Write #fnum, "" 'use Print when you want the string without quotation marks ' Print #fnum, "I wrote this also" lngCount = 0 Print #fnum, "Enabled Command Bars:" For Each cbr In CommandBars If cbr.Enabled = True Then lngCount = lngCount + 1 ' Add a running count 'Print info to text file Print #fnum, lngCount & " " & cbr.Name & ", Enabled: " & cbr.Enabled Print #fnum, vbTab & "BuiltIn: " & cbr.BuiltIn & ", Visible: " & cbr.Visible Print #fnum, vbTab & "Type: " & cbr.Type & ", NameLocal: " & cbr.NameLocal Print #fnum, vbTab & "Position: " & cbr.Position & ", Protection: " & cbr.Protection Print #fnum, "" 'Debug.Print cbr.Name, cbr.Visible End If Next cbr Close #fnum End Sub