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

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

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

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

@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

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

I'm getting no errors when I compile.

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

Rey,

Here are the 3 places it finds FindClose:

Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Select allOpen 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

Select allOpen 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

Select allOpen in new window

If I put my cursor on it and click Definition, it goes to the Declaration.

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

Rey,

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

Thanks,
gdunn59

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.

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

Select allOpen 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

try dimming first the array

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

Rey,

So do I get rid of this line:

ReDim Preserve strResults(UBound(strResults) + 1)

no, I did not say that.

So where do I add the line?

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

Thanks,
gdunn59

ok. I give up

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

I just asked where do I put it since the variable "strResults" is declared a couple of places.

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

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.

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

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

Thanks,
gdunn59

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

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

Thanks