Write Table Info To Text

**jo15765** · 10-28-2016, 05:22 PM

My module is almost complete, but I am getting a run time error of - Application Defined or Object Defined Error on this line of code

Code:

If objRegExp.test(objFile) Then

I have these references added to my project

Code:

Visual Basic For Application
Microsoft Access 15.0 Object Library
OLE Automation
Office 15.0 Access Database Engine Object
Microsoft Scripting Runtime

And this is full syntax. What do I need to alter in order for my code to execute as I so desire?

Code:

Sub ScanTablesWriteDataToText()
    Dim Fileout As Object
    Dim fso As Object
    Dim objFSO As Object
    Dim accapp As Access.Application
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Set objFSO = CreateObject("Scripting.FileSystemObject")
 
    Dim objRegExp As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.pattern = "*.accdb"
    objRegExp.IgnoreCase = True
 
    Dim colFiles As Collection
    Set colFiles = New Collection
 
    RecursiveFileSearch "C:\Test\", objRegExp, colFiles, objFSO
 
    For Each f In colFiles
        Set accapp = New Access.Application
        accapp.OpenCurrentDatabase (filename)
        accapp.Visible = False
        Set db = accapp.CurrentDb
        For Each tdf In db.TableDefs
          If Not (tdf.name Like "MSys*") Then
                Set fso = CreateObject("Scripting.FileSystemObject")
                Set Fileout = fso.OpenTextFile("C:\datafile.txt", 8, True)
                Fileout.Write CStr(filename) & "," & name & "," & connect & vbCrLf
                Fileout.Close
          End If
        Next
        Set tdf = Nothing
        Set db = Nothing
    Next
    Set objFSO = Nothing
    Set objRegExp = Nothing
 
End Sub
Sub RecursiveFileSearch(ByVal targetFolder As String, ByRef objRegExp As Object, _
                    ByRef matchedFiles As Collection, ByRef objFSO As Object)
 
    Dim objFolder As Object
    Dim objFile As Object
    Dim objSubFolders As Object
    Set objFolder = objFSO.GetFolder(targetFolder)
    For Each objFile In objFolder.files
        If objRegExp.test(objFile) Then
            matchedFiles.Add (objFile)
        End If
    Next
    Set objSubFolders = objFolder.Subfolders
    For Each objSubfolder In objSubFolders
        RecursiveFileSearch objSubfolder, objRegExp, matchedFiles, objFSO
    Next
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objSubFolders = Nothing
 
End Sub

**Micron** · 10-28-2016, 05:35 PM

I'd say it's because there's no reference to DAO in your list. Usually, the offending part is highlighted when there is a compile error, but you have not indicated what that is.

**jo15765** · 10-28-2016, 05:48 PM

Originally Posted by Micron

I'd say it's because there's no reference to DAO in your list. Usually, the offending part is highlighted when there is a compile error, but you have not indicated what that is.

it is a run time error not a compile time. And this is the offending line

Code:

If objRegExp.test(objFile) Then

Is it a reference to
Microsoft DAO 3.6 Object Library

If that is the case, anytime I try to add this reference i get an error of:
Error in loading dll

**Micron** · 10-28-2016, 06:07 PM

Sorry, I missed that. The only other suggestion I have is to try Set objRegExp = New RegExp
as opposed to
Set objRegExp = CreateObject("VBScript.RegExp")

The lack of capitalization on the method (such as .pattern) suggests the object has not been formed, thus giving the defined error message.

**jo15765** · 10-28-2016, 06:27 PM

If I comment out

Code:

Set objRegExp = CreateObject("VBScript.RegExp")

and add

Code:

Set objRegExp = New RegExp

I get a debug error of
User defined type not defined
on the line

Code:

New RegExp

**jo15765** · 10-28-2016, 06:36 PM

I have worked through this error, by adding (I know this is best practice)

Code:

option explicit

to the top of my method which pointed out on this line

Code:

accapp.OpenCurrentDatabase (filename)

I had not declared the variable filename, so I changed this to

Code:

accapp.OpenCurrentDatabase (f)

However, now when the data is written to a text file I get Chinese symbols instead of American English.

Is there a caveat to using

Code:

Fileout.Write CStr(filename) & "," & name & "," & connect & vbCrLf

that puts the text in that language?

**Micron** · 10-28-2016, 07:03 PM

You know, Option Explicit was the first thing that I noticed was missing, but to be honest, I assumed anybody who could work with scripting languages such as this would not make that oversight. I just figured it was at the top of the module along with the Option Compare statement.

As for the Chinese characters, I doubt that is the normal result - wouldn't make sense. Besides, this character substitution problem has been covered in this forum at least once before. Search the forum for "chinese characters" and I think you'll find the general consensus is that it is due to db corruption. I'd try a compact/repair before coding anything else.

**jo15765** · 10-28-2016, 07:12 PM

It was honestly pure oversight on my part for excluding it. In practice I do always add that to the top.

As for the Chinese characters, I created a blank new database and ran the procedure again with the same result.

I'll search the forums and see if anyone has relevant information for me.

Thanks for your help!

**ssanfu** · 10-28-2016, 07:25 PM

Here is what I have found:

Yes

, the top two lines in EVERY module should be:

Code:

Option Compare Database
Option Explicit

I found 3 variables not declared: "FileName", "Connect" and "f"
I would guess that the first two would be strings.
The "f" should be declared as a Variant.
'----------------------------

For this line in the code, delete the "*":

Code:

objRegExp.pattern = "*.accdb"

Use

Code:

objRegExp.pattern = ".accdb"

The Recursive File Search subroutine now works for me.
'----------------------------

Next is the code for the outer For...Next loop.
If you changed "Filename" to "f", "f" contains the full path and file name of an Access dB, so you can open the dB.
'----------------------------

Now the inner For...Next loop.
If you changed "Filename" to "f"

Code:

Fileout.Write CStr(f) & "," & Name & "," & Connect & vbCrLf

What are you converting to a string to print? Remember, "f" contains the full path and filename of the dB.
So you would NOT be printing the contents (data) of the dB, you would be printing the actual dB file bits and bytes!!

Since the inner For...Next loop is dealing with table defs, you need to open each table and loop through the records and fields, printing the data.
Don't know what to recommend to you - not sure what you are trying to print.
'----------------------------

Lastly, these two lines should NOT be inside the For...Next loops.

Code:

    Set tdf = Nothing
    Set db = Nothing

You do not want to destroy the two variables while you are still using them.
The last lines should be

Code:

<snip>
        Next
    Next

    Set tdf = Nothing
    Set db = Nothing
    Set colFiles = Nothing  '<<--I added this line

    Set objFSO = Nothing
    Set objRegExp = Nothing

End Sub

'----------------------------

I am still wondering what "Name" and "Connect" are in the code:

Code:

Fileout.Write CStr(FileName) & "," & Name & "," & Connect & vbCrLf

Good luck with your project.......

**jo15765** · 10-28-2016, 07:37 PM

This line

Code:

Fileout.Write CStr(FileName) & "," & Name & "," & Connect & vbCrLf

Should actually be

Code:

Fileout.Write CStr(FileName) & "," & tdf.Name & "," & tdf.Connect & vbCrLf

What I am after is the name of every database that has a linked table (full database name) the table name, and the connection string for the linked table.

May be a simpler way of achieving such, but w/ exception of my Chinese characters my syntax is working as expected.

**Micron** · 10-28-2016, 07:45 PM

@ssanfu, some great detective work there. I should refrain from posting when imbibing during and concentrating on the baseball game (Cubs - Indians still tied)!
@jo15765, suggest you set 'require variable declaration' as default so you don't have to worry about it

In case you're interested, I'm a Blue Jays fan and in this 3rd world series game, the home plate umpire is atrocious.

**ssanfu** · 10-28-2016, 09:54 PM

Maybe this??

Code:

Sub ScanTablesWriteDataToText()
    Dim Fileout As Object
    Dim fso As Object
    Dim objFSO As Object
    Dim accapp As Access.Application
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim objRegExp As Object
    Dim colFiles As Collection

    '-------------------------------
    'this was not declared
    Dim f As Variant
    '-------------------------------

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Pattern = ".accdb"   ' <-- I deleted the "*"
    objRegExp.IgnoreCase = True

    Set colFiles = New Collection

    RecursiveFileSearch "C:\Test\", objRegExp, colFiles, objFSO

    'create a text file
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Fileout = fso.OpenTextFile("C:\datafile.txt", 8, True)

    'loop through the colFiles collection
    For Each f In colFiles
        Set accapp = New Access.Application
        accapp.OpenCurrentDatabase (f)
        accapp.Visible = False
        Set db = accapp.CurrentDb
        For Each tdf In db.TableDefs
            If Not (tdf.Name Like "MSys*") Then
                'test for a linked table
                If Len(Trim(tdf.Properties("Connect") & "")) > 1 Then
                    Fileout.Write CStr(f) & "," & tdf.Name & "," & tdf.Connect & vbCrLf
                End If
            End If
        Next
    Next
    'close text file
    Fileout.Close

    'clean up
    Set tdf = Nothing
    Set db = Nothing
    Set colFiles = Nothing

    Set objFSO = Nothing
    Set objRegExp = Nothing

End Sub

Sub RecursiveFileSearch(ByVal targetFolder As String, ByRef objRegExp As Object, _
                        ByRef matchedFiles As Collection, ByRef objFSO As Object)

    Dim objFolder As Object
    Dim objFile As Object
    Dim objSubFolders As Object
    Dim objSubFolder As Variant
    
    Set objFolder = objFSO.GetFolder(targetFolder)
    For Each objFile In objFolder.Files
        If objRegExp.test(objFile) Then
            matchedFiles.Add (objFile)
        End If
    Next
    Set objSubFolders = objFolder.Subfolders
    For Each objSubFolder In objSubFolders
        RecursiveFileSearch objSubFolder, objRegExp, matchedFiles, objFSO
    Next
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objSubFolders = Nothing

End Sub

Write Table Info To Text

Thread Tools

Write Table Info To Text

Similar Threads

How to export Google Calendar and write info to Outlook ZCalendar

updating a text box on a form with info in a combo box on a table

How do I write to a table from text box

updating table info in a form from related info in another table

Write text to text box on a form

Posting Permissions