Access database

[sparkbyte]

I have a script that will search any drive letter provided for *.mdb files and output that data to an Excel spreadsheet. What I am wanting to add to it is the ability to tell me if the Access DB has link tables and what they are.

Any ideas or sample code would be appreciated.

Here is the code to the file search script.

'-----------------------------------------------------------------
'-----------------------------------------------------------------
' Script: File Extension Report to Excel
' Author: John Fuhrman
' Date: 2009-10-29
' Description: This script will prompt for the drive letter and 
' file extension that will be searched for and outputs the 
' results into an Excel spreadsheet
'-----------------------------------------------------------------
'-----------------------------------------------------------------
 Dim strDrive, strExtension, strComputer, strExcelPath

 strDrive = DriveSelect 'Run function for setting the Drive Letter Variable

 strExtension = FileExtension  'Run Function to set the File Extension to search for.

' Spreadsheet file to be created.
   strExcelPath = strDrive & "-Access_Application_Listing.xls"

' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Excel application not found."
  Wscript.Quit
End If
On Error GoTo 0

' Create a new workbook.
objExcel.Workbooks.Add

' Bind to worksheet.
Set objWorksheet = objExcel.ActiveWorkbook.Worksheets(1)
objWorksheet.Name = strExtension & " Files Report"

' Populate spreadsheet cells with user attributes.
objWorksheet.Cells(1, 1).Value = "Access Application Name"
objWorksheet.Cells(1, 2).Value = "Drive"
objWorksheet.Cells(1, 3).Value = "Location"
objWorksheet.Cells(1, 4).Value = "File Size"
objWorksheet.Cells(1, 5).Value = "Can be Archived or Deleted"
objWorksheet.Cells(1, 6).Value = "Point of Contact"
objWorksheet.Cells(1, 7).Value = "POC Contact Number"

 strComputer = "."     ' use "." for local computer 
 
 Set objWMIService = GetObject("winmgmts:" _ 
     & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
 
 Set colFiles = objWMIService. _ 
     ExecQuery("Select * from CIM_DataFile" _ 
         & " where Drive=" & "'" & Ucase(strDrive) & ":' and Extension='" &_
                Ucase(strExtension) & "'") 
' WScript.Echo "# of files found: " & colFiles.Count 
 
intCounter = 0
k = 2
 For Each objFile in colFiles 
        objWorksheet.Cells(k, 1).Value = objFile.FileName
        objWorksheet.Cells(k, 2).Value = objFile.Drive
        objWorksheet.Cells(k, 3).Value = objFile.Path
        objWorksheet.Cells(k, 4).Value = objFile.FileSize
        objWorksheet.Cells(k, 5).Value = ""
        objWorksheet.Cells(k, 6).Value = ""
        objWorksheet.Cells(k, 7).Value = ""
        objWorksheet.Cells(k, 8).Value = ""
k = k + 1
Next

' Format the spreadsheet.
objWorksheet.Range("A1:Z1").Font.Bold = True

Set objRange = objWorksheet.UsedRange
objRange.EntireColumn.Autofit()

Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1
Set objRange = objWorksheet.UsedRange
Set objRange2 = objExcel.Range("B1")    'Sort by Drive'
Set objRange3 = objExcel.Range("C1")    'Sort by Path'
objRange.Sort objRange2, xlAscending, , , , , , xlYes
objRange.Sort objRange3, xlAscending, , , , , , xlYes

' Save the spreadsheet and close the workbook.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close

' Quit Excel.
objExcel.Application.Quit


wscript.quit


 Function DriveSelect()
 Dim strDriveSelect, strDriveErr
 strDriveSelect=InPutBox("Enter Letter of Drive to Search :","Search Drive","O")
    Do Until strDriveSelect <> "" 
        strDriveErr=MsgBox("Drive Letter Not Entered",69,"Missing Parameter")
            Select Case strDriveErr
                Case vbOK
                     wscript.echo = "OK was clicked"
                Case vbCancel
'                     wscript.echo "Cancel was clicked"
                     wscript.quit
                Case vbAbort
                     wscript.echo "Abort was clicked"
                     Exit Do
                Case vbRetry
                     strDriveSelect=InPutBox("Enter Letter of Drive to Search :",_
                     "Search Drive","O")
'                     wscript.echo "Retry was clicked"
                Case vbIgnore
                     wscript.echo "Ignore was clicked"
                Case vbYes
                     wscript.echo "Yes was clicked"
                Case vbNo
                     wscript.echo "No was clicked"
                Case Else
                     wscript.echo "Do Over"
                     wscript.quit
           End Select
    Loop
   DriveSelect = Ucase(strDriveSelect)
 End Function
 
 Function FileExtension()
 Dim strFileExtension, strExtensionErr
 strFileExtension=InPutBox("Enter File Name Extension to search for.","File Extension Search","MDB") 
    Do While strFileExtension = ""
        strExtensionErr=MsgBox("File Extension Not Entered",69,"Missing Parameter")
            Select Case strExtensionErr
                Case vbOK
                     wscript.echo = "OK was clicked"
                Case vbCancel
'                     wscript.echo "Cancel was clicked"
                     wscript.quit
                Case vbAbort
                     wscript.echo "Abort was clicked"
                     Exit Do
                Case vbRetry
                     strFileExtension=InPutBox("Enter File Name Extension to search for.",_
                     "File Extension Search","MDB")
'                     wscript.echo "Retry was clicked"
                Case vbIgnore
                     wscript.echo "Ignore was clicked"
                Case vbYes
                     wscript.echo "Yes was clicked"
                Case vbNo
                     wscript.echo "No was clicked"
                Case Else
                     wscript.echo "It's Broken"
                     wscript.quit
            End Select
    Loop
 FileExtension = Ucase(strFileExtension)
 End Function

Thanks

John Fuhrman
Titan Global Services

http://www.titangs.com

faq329-6766

 

[dilettante]

Just a suggestion:

Perhaps open the MDB and iterate its Tables collection. Probably the easiest way would be to open a Connection, then create an ADOX.Catalog and set its ActiveConnection to this Connection.

The Catalog should have a Tables collection. Each Table in this collection will have various properties including Jet Extended properties.

If:

[tt]objTable.Properties("Jet OLEDB:Create Link")[/tt]

... is True, then you could check other properties such as:

[tt]Jet OLEDB:Link Datasource
Jet OLEDB:Link Provider String
Jet OLEDB:Remote Table Name[/tt]

... for the values you seem to be after.