We help IT Professionals succeed at work.

New podcast episode! Our very own Community Manager, Rob Jurd, gives his insight on the value of an online community. Listen Now!

x

Why is Access Closing Out Each Time it Gets to a Certain Line of VBA Code

gdunn59
gdunn59 asked
on
68 Views
Last Modified: 2017-03-21
I have the following code, and whenever it gets to Line 22 of the Code it closes Access.

Function FindFolders(strStartDir As String, strResults() As String) As Long 'NOTE: this is non recursive, so the results will only show for the given folder
  On Error GoTo ErrHandler
  Dim wfd As WIN32_FIND_DATA
  Dim nFind As Long
  Dim strDirectoryName As String
  ReDim strResults(0) '0 will not be used
  
  If InStr(1, strStartDir, "*") < 1 Then
    If Right(strStartDir, 1) <> "\" Then strStartDir = strStartDir & "\"
    strStartDir = strStartDir & "*"
  End If

  nFind = FindFirstFile(strStartDir, wfd)   'api call
  If (wfd.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) > 0 Then     'if this is a directory
     strDirectoryName = Left(wfd.cFileName, InStr(1, wfd.cFileName, Chr(0)) - 1)
     If strDirectoryName <> "." And strDirectoryName <> ".." Then
       ReDim Preserve strResults(UBound(strResults) + 1)
       strResults(UBound(strResults)) = strDirectoryName
     End If
  End If
  Do While FindNextFile(nFind, wfd)
    If (wfd.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) > 0 Then  'if this is a directory
      strDirectoryName = Left(wfd.cFileName, InStr(1, wfd.cFileName, Chr(0)) - 1)
      If strDirectoryName <> "." And strDirectoryName <> ".." Then
        ReDim Preserve strResults(UBound(strResults) + 1)
        strResults(UBound(strResults)) = strDirectoryName
      End If
    End If
  Loop
  
ErrHandler:
  FindClose nFind
  FindFolders = ErrorHandler(err, "FindFolders")
End Function

Open in new window


Here are the declarations:
Private Declare PtrSafe Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare PtrSafe Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Open in new window


Thanks,
gdunn59
Comment
Watch Question

CERTIFIED EXPERT
Top Expert 2016

Commented:
what is this line for
       FindClose nFind

- to see If your code is getting an error, comment this line    ' On Error GoTo ErrHandler
and see which line is raising the error, it could be line 22

Author

Commented:
Rey,

I'm not sure what the line  FindClose nFind is for.  I didn't write the code.

Also, I commented out the Error line you told me to.  The problem is whenever it gets to line 21 (I said Line 22 in my initial post, but it is actually Line 21), it closes Access.

This is another one of the databases that was converted from MS Access 2013 to MS Access 2016, and upgraded from Windows 7 to Windows 10.  Prior to these conversions and upgrades, it worked fine.

Thanks,
gdunn59

Author

Commented:
Rey,

Also, I'm working on a 64 bit computer now,  not 32 bit.

I noticed the variable wfd has been declared as WIN32_FIND_DATA.

Could that be what's causing the issue?

Thanks,
gdunn59
Dale FyeOwner, Dev-Soln LLC
CERTIFIED EXPERT
Most Valuable Expert 2014
Top Expert 2010

Commented:
@gdunn,

it is not so much what Operating System (32 or 64 bit) you are using, it has to do with the version of Access.  But if these are API calls, you would probably be getting an error message as soon as you attempt to compile if the API is not compatible with the version of Office you are using.

Dale
CERTIFIED EXPERT
Top Expert 2016

Commented:
from VBA window, do a DEBUG >COMPILE
- see if there are codes that does not compile

Author

Commented:
I'm getting no errors when I compile.
CERTIFIED EXPERT
Top Expert 2016

Commented:
place your cursor on FindClose right click and select definition, see where it will take you.

Author

Commented:
Rey,

Here are the 3 places it finds FindClose:
Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Open in new window


Function FindFolders(strStartDir As String, strResults() As String) As Long 'NOTE: this is non recursive, so the results will only show for the given folder
  On Error GoTo ErrHandler
  Dim wfd As WIN32_FIND_DATA
  Dim nFind As Long
  Dim strDirectoryName As String
  ReDim strResults(0) '0 will not be used
  
  'if there is already a wildcard then leave the StartDir be (example for user passed is C:\blah\T* = all folders that start with a T
  If InStr(1, strStartDir, "*") < 1 Then
    If Right(strStartDir, 1) <> "\" Then strStartDir = strStartDir & "\"
    strStartDir = strStartDir & "*"
  End If

  nFind = FindFirstFile(strStartDir, wfd)   'api call
  If (wfd.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) > 0 Then     'if this is a directory
     strDirectoryName = Left(wfd.cFileName, InStr(1, wfd.cFileName, Chr(0)) - 1)
     If strDirectoryName <> "." And strDirectoryName <> ".." Then
       ReDim Preserve strResults(UBound(strResults) + 1)
       strResults(UBound(strResults)) = strDirectoryName
     End If
  End If
  Do While FindNextFile(nFind, wfd)
    If (wfd.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) > 0 Then  'if this is a directory
      strDirectoryName = Left(wfd.cFileName, InStr(1, wfd.cFileName, Chr(0)) - 1)
      If strDirectoryName <> "." And strDirectoryName <> ".." Then
        ReDim Preserve strResults(UBound(strResults) + 1)
        strResults(UBound(strResults)) = strDirectoryName
      End If
    End If
  Loop
  
ErrHandler:
  FindClose nFind
  FindFolders = ErrorHandler(err, "FindFolders")
End Function

Open in new window


Function FindFiles(strStartDir As String, strResults() As String) As Long
  On Error GoTo ErrHandler
  Dim wfd As WIN32_FIND_DATA
  Dim nFind As Long
  Dim strFilePath As String
  ReDim strResults(0) '0 will not be used

  nFind = FindFirstFile(strStartDir, wfd)   'api call

  strFilePath = Left(wfd.cFileName, InStr(1, wfd.cFileName, Chr(0)) - 1)
  If strFilePath <> "." And strFilePath <> ".." And strFilePath <> "" Then
    ReDim Preserve strResults(UBound(strResults) + 1)
    strResults(UBound(strResults)) = strFilePath
  End If
  Do While FindNextFile(nFind, wfd)
    strFilePath = Left(wfd.cFileName, InStr(1, wfd.cFileName, Chr(0)) - 1)
    If strFilePath <> "." And strFilePath <> ".." And strFilePath <> "" Then
      ReDim Preserve strResults(UBound(strResults) + 1)
      strResults(UBound(strResults)) = strFilePath
    End If
  Loop
  
ErrHandler:
  FindClose nFind
  FindFiles = ErrorHandler(err, "FindFiles")
End Function

Open in new window


If I put my cursor on it and click Definition, it goes to the Declaration.
CERTIFIED EXPERT
Top Expert 2016

Commented:
do a decompile, see this link  http://www.fmsinc.com/microsoftaccess/performance/decompile.asp
then do  a Debug >Compile
than do a compact and repair

Author

Commented:
Rey,

I'll give your last posting a try and let you know.

Thanks,
gdunn59

Author

Commented:
Rey,

I did the following exactly, and still having the same issue.

To decompile your database, follow these steps

From the Windows, Start, Run command line, type: msaccess.exe /decompile
where msaccess.exe includes the complete path. For example, for Access 2016:

C:\Program Files\Microsoft Office\Office16\MSACCESS.EXE /decompile

From Access open the database you want to decompile (with trusted authority for Access 2003 or later)
Open up any module. Compile it via Debug, Compile.., then File, Save.
Go back to the database and Compact it. The location of the Compact command varies by Access version.
The database size should be reduced and the strange errors related to the VBA code should be gone.

Author

Commented:
Rey,

As I'm stepping through the code, when it gets to this block of code, on Line 5 of the code, if I put my cursor over the variable "strResults", it shows the following:

Block of Code:
  nFind = FindFirstFile(strStartDir, wfd)   'api call
  If (wfd.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) > 0 Then     'if this is a directory
     strDirectoryName = Left(wfd.cFileName, InStr(1, wfd.cFileName, Chr(0)) - 1)
     If strDirectoryName <> "." And strDirectoryName <> ".." Then
       ReDim Preserve strResults(UBound(strResults) + 1)
       strResults(UBound(strResults)) = strDirectoryName
     End If
  End If

Open in new window

strResults(UBound(strResults) + 1) = <Subscript out of range>

If I put the variable "strResults" in my Immediate Window I get the following error:

Compile error:

Type mismatch

If I add a Watch on the variable "strResults", it shows the actual folder name.

Thanks,
gdunn59
CERTIFIED EXPERT
Top Expert 2016

Commented:
try dimming first the array

Dim strResults() as variant  'add this line
ReDim strResults(0) '0 will not be used

Author

Commented:
Rey,

So do I get rid of this line:

ReDim Preserve strResults(UBound(strResults) + 1)
CERTIFIED EXPERT
Top Expert 2016

Commented:
no, I did not say that.

Author

Commented:
So where do I add the line?

The variable "strResults" is declared a few times in the Function FindFiles.

Thanks,
gdunn59
CERTIFIED EXPERT
Top Expert 2016

Commented:
ok. I give up

you need to hire somebody to make this work for you.

Author

Commented:
I just asked where do I put it since the variable "strResults" is declared a couple of places.
CERTIFIED EXPERT
Top Expert 2016

Commented:
you need to  read the post and see where it was placed with reference to your codes

Author

Commented:
I put it where it was referenced in my code, and I get a duplicate declaration error.

I'm sorry I am not an expert with WIN32_FIND_DATA.  I've never written VBA Code using that.  This code was written by someone else who is no longer here, and it worked fine prior to upgrading to Windows 10 and MS Access 2016.

Author

Commented:
Is there anyone else at there willing to assist me?????  Your assistance would be GREATLY APPRECIATED!!!!!!

I just got on a Windows 7 machine with MS Access 2013 and opened the version for that environment, and all works fine.  So it definitely has something to do with upgrading to Windows 10 and MS Access 2016.

Thanks,
gdunn59
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION

Author

Commented:
The experts were never able to resolve my issues.  I did figure it out myself and it's working now.

Thanks,
gdunn59
Dale FyeOwner, Dev-Soln LLC
CERTIFIED EXPERT
Most Valuable Expert 2014
Top Expert 2010

Commented:
gdunn,

Can you advise us of what your solution was?  I'm interested in hearing what the cause of the problem was, and how you resolved it.

Dale

Author

Commented:
Had to change one of my variables from Long to LongPtr.  I missed one.

Thanks
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.