Solved

Code works when I step through but not when I let it run

Posted on 2009-04-05
21
237 Views
Last Modified: 2013-11-27
The goal of the code to export data from my Access 2003 db to an external app which imports the information. The code i wrote works perfectly if I step through it in debugger mode. The problem is that when I run the code at full speed it does not run correctly - it does not create the files as it should.
Public Function CreateCCCFiles()
 

Dim Qstring, NameStr, FileVar As String

Dim i As Long

Dim db As Database

Dim qdfTemp As QueryDef

Dim qdfNew As QueryDef

Dim qd As QueryDef

Dim Stats As Recordset

DoCmd.SetWarnings False

DoCmd.OpenQuery "DelAdmin1"

DoCmd.OpenQuery "DelAdmin2"

DoCmd.OpenQuery "DelEnvelope"

DoCmd.OpenQuery "DelVehicle"

DoCmd.OpenQuery "XEnvelope"

DoCmd.OpenQuery "XAdmin1"

DoCmd.OpenQuery "XAdmin2"

DoCmd.OpenQuery "XVehicle"
 

Set db = CurrentDb

Set dbs = OpenDatabase("c:\ccs\ccs97_be.mdb")

Set Stats = dbs.OpenRecordset("ExEnvelope")
 
 

 Stats.MoveFirst

Loopit:

If Stats.EOF = True Then

    GoTo Jumpout

End If

FileVar = Stats![RO_ID]

If Len(FileVar) = 7 Then

    NameStr = Stats![RO_ID] & "X.env"

Else

    NameStr = Stats![RO_ID] & ".env"

End If

   With db

   With Application.FileSearch

    .NewSearch

    .LookIn = "c:\Pathways\Data\EXTCOMM\EMSIN"
 

    .SearchSubFolders = False

    .FileName = "*.dbf"

    .MatchTextExactly = True

    If .Execute() > 0 Then

         Kill "c:\Pathways\Data\EXTCOMM\EMSIN\*.dbf"

    End If

    End With
 
 

    For Each qd In CurrentDb.QueryDefs

        If qd.Name = "DumpIt" Then

            DoCmd.DeleteObject acQuery, "DumpIt"

        End If

    Next

      ' Create permanent QueryDef.

      Set qdfNew = .CreateQueryDef("DumpIt", _

         "SELECT ExEnvelope.* From ExEnvelope WHERE (((ExEnvelope.RO_ID)='" & FileVar & "'));")

      DoCmd.TransferDatabase acExport, "dbase IV", "c:\Pathways\Data\EXTCOMM\EMSIN", acQuery, "DumpIt", NameStr, 0, 0
 

      .QueryDefs.Delete "Dumpit"

      LenStr = Len(Stats![RO_ID])

      If LenStr = 7 Then

          OldName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & "X.dbf"

          NewName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & "X.env"

      Else

          OldName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & ".dbf"

          NewName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & ".env"

      End If

      Name OldName As NewName

      Set qdfNew = .CreateQueryDef("DumpIt", _

         "SELECT ExAdmin1.* From ExAdmin1 WHERE (((ExAdmin1.ASGN_NO)='" & FileVar & "'));")

      DoCmd.TransferDatabase acExport, "dbase IV", "c:\Pathways\Data\EXTCOMM\EMSIN", acQuery, "DumpIt", NameStr, 0, 0

      .QueryDefs.Delete "Dumpit"

      If LenStr = 7 Then

          OldName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & "X.dbf"

          NewName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & "X.AD1"

      Else

          OldName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & ".dbf"

          NewName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & ".AD1"

      End If

      Name OldName As NewName

      Set qdfNew = .CreateQueryDef("DumpIt", _

         "SELECT ExAdmin2.* From ExAdmin2 WHERE (((ExAdmin2.EST_CO_NM)='" & FileVar & "'));")

      DoCmd.TransferDatabase acExport, "dbase IV", "c:\Pathways\Data\EXTCOMM\EMSIN", acQuery, "DumpIt", NameStr, 0, 0

      .QueryDefs.Delete "Dumpit"

      If LenStr = 7 Then

            OldName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & "X.dbf"

            NewName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & "X.AD2"

      Else

            OldName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & ".dbf"

            NewName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & ".AD2"

      End If

      

      Name OldName As NewName

      Set qdfNew = .CreateQueryDef("DumpIt", _

         "SELECT ExVehicle.* From ExVehicle WHERE (((ExVehicle.V_MAKEDESC)='" & FileVar & "'));")

      DoCmd.TransferDatabase acExport, "dbase IV", "c:\Pathways\Data\EXTCOMM\EMSIN", acQuery, "DumpIt", NameStr, 0, 0

      .QueryDefs.Delete "Dumpit"

      If LenStr = 7 Then

            OldName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & "X.dbf"

            NewName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & "X.VEH"

      Else

            OldName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & ".dbf"

            NewName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & ".VEH"

      End If

      Name OldName As NewName

   End With

Stats.MoveNext

GoTo Loopit

Jumpout:

Stats.Close

DoCmd.OpenQuery "ClrExportStatus"

DoCmd.SetWarnings True

MsgBox "Export to Pathways Complete", vbInformation, "Pathways Export"

Open in new window

0
Comment
Question by:hapropper
  • 8
  • 7
  • 5
  • +1
21 Comments
 

Author Comment

by:hapropper
ID: 24071240
Additional Comment - I removed the "On Error resume next" from the code so I could see if errors were occurring and they were. I would get either a 3011 error or a 3167 error each time I hit the line:

DoCmd.TransferDatabase acExport, "dbase IV", "c:\Pathways\Data\EXTCOMM\EMSIN", acQuery, "DumpIt", NameStr, 0, 0

if I hit debug and and then ran the code again it would proceed until the next "Transferdatabase" command and throw another error. The funny thing is that it produced the output and result I desired.

So why is it throwing off these errors even though it is actually working correctly?

I have tried running this on a standalone Vista computer and on a network where they are running Windows server 2003 with the same results.
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 24071247
If you modify this code to create One File per run, does it work?

In other words instead of creating the code to create a dozen files at one time, just create the code to do 1, then see what happens.

If this does not work, figure out why before adding any more files.

Then add 1 or 2 more files to the code and repeat.

At least you will see where the issue is.
Make sense?
;-)

JeffCoachman
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 24071258
Does this file need/have an extension?:
    c:\Pathways\Data\EXTCOMM\EMSIN

.dbf  perhaps?
0
 
LVL 8

Expert Comment

by:Emil_Gray
ID: 24071472
Try the following:
Public Function CreateCCCFiles()

Dim Qstring, NameStr, FileVar As String

On Error GoTo Err_Correction

.
.
.
  With db
   With Application.FileSearch
    .NewSearch
    .LookIn = "c:\Pathways\Data\EXTCOMM\EMSIN"

    .SearchSubFolders = False
    .FileName = "*.dbf"
    .MatchTextExactly = True
    If .Execute() > 0 Then
         Kill "c:\Pathways\Data\EXTCOMM\EMSIN\*.dbf"
    End If
    End With

Err_Correction:
If Err.Number = 3011 Or Err.Number = 3067 Then Resume Next
0
 
LVL 45

Expert Comment

by:aikimark
ID: 24071730
@hapropper,

Do you have an Option Explicit statement in the general declarations section of this routine?

Rather than deleting and recreating the Dumpit three times, just change the DumpIt query's SQL.  It's less work and less of a chance of things going wrong.

It looks like you stopped a bit short.  I think you meant to code.  Look in snippet below the =============

Comments on good programming style.  GoTo looping can be messy.  Proper indentation helps.
Instead, consider:

  Set Stats = dbs.OpenRecordset("ExEnvelope")
  Do Until Stats.EOF
    FileVar = Stats![RO_ID]
    If Len(FileVar) = 7 Then
      NameStr = Stats![RO_ID] & "X.env"
    Else
      NameStr = Stats![RO_ID] & ".env"
    End If
...
    End With
    Stats.MoveNext
  Loop
  Stats.Close
... 
=====================================
If Len(FileVar) = 7 Then
    NameStr = Stats![RO_ID] & "X"
Else
    NameStr = Stats![RO_ID] 
End If 
'*** This isn't necessary any more *****
'      LenStr = Len(Stats![RO_ID])
'      If LenStr = 7 Then
'          OldName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & "X.dbf"
'          NewName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & "X.env"
'      Else
'          OldName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & ".dbf"
'          NewName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & Stats![RO_ID] & ".env"
'      End If
'********************************** 
          OldName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & NameStr & ".dbf"
          NewName = "c:\Pathways\Data\EXTCOMM\EMSIN\" & NameStr & ".env"

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 24071880
Complete cleaned-up version of this routine.  A simpler routine may help identify the cause of the error.
Public Function CreateCCCFiles()

 

  Dim NameStr As String, FileVar As String

  Dim db As Database

  Dim dbs As Database     'was missing in EE question

  Dim qdfNew As QueryDef

  Dim qd As QueryDef

  Dim Stats As Recordset

  Const cOutputDir As String = "c:\Pathways\Data\EXTCOMM\EMSIN\"

  

  Set db = CurrentDb

  Set dbs = OpenDatabase("c:\ccs\ccs97_be.mdb")

  Set Stats = dbs.OpenRecordset("ExEnvelope", dbOpenTable)

  

  DoCmd.SetWarnings False

  db.Execute "DelAdmin1"  'db.execute better than docmd.openquery

  db.Execute "DelAdmin2"

  db.Execute "DelEnvelope"

  db.Execute "DelVehicle"

  db.Execute "XEnvelope"

  db.Execute "XAdmin1"

  db.Execute "XAdmin2"

  db.Execute "XVehicle"

  

  'Since DumpIt is deleted at the end if this process, it is

  'NOT a 'permanent' query definition.

  For Each qd In db.QueryDefs

    If qd.Name = "DumpIt" Then

      db.QueryDefs.Delete qd.Name

      Exit For    'no need to keep looking

    End If

  Next

  ' Create temporary named QueryDef -- deleted at end of routine

  Set qdfNew = db.CreateQueryDef("DumpIt", _

               "SELECT * From ExEnvelope WHERE 0=1;")

  

  'Delete any existing .dbf files in output directory before data export

  FileVar = Dir(cOutputDir & "*.dbf")

  If Len(FileVar) <> 0 Then

    Kill cOutputDir & "*.dbf"

  End If

  

  Do Until Stats.EOF

    FileVar = Stats![RO_ID]

    If Len(FileVar) = 7 Then

        NameStr = Stats![RO_ID] & "X"

    Else

        NameStr = Stats![RO_ID]

    End If

    

    qdfNew.SQL = "SELECT ExEnvelope.* From ExEnvelope WHERE (((ExEnvelope.RO_ID)='" & FileVar & "'));"

    DoCmd.TransferDatabase acExport, "dbase IV", cOutputDir, acQuery, "DumpIt", NameStr, 0, 0

    

    OldName = cOutputDir & NameStr & ".dbf"

    newname = cOutputDir & NameStr & ".env"

    Name OldName As newname

      

    qdfNew.SQL = "SELECT ExAdmin1.* From ExAdmin1 WHERE (((ExAdmin1.ASGN_NO)='" & FileVar & "'));"

    DoCmd.TransferDatabase acExport, "dbase IV", cOutputDir, acQuery, "DumpIt", NameStr, 0, 0

    

    OldName = cOutputDir & NameStr & ".dbf"

    newname = cOutputDir & NameStr & ".AD1"

    Name OldName As newname

    

    qdfNew.SQL = "SELECT ExAdmin2.* From ExAdmin2 WHERE (((ExAdmin2.EST_CO_NM)='" & FileVar & "'));"

    DoCmd.TransferDatabase acExport, "dbase IV", cOutputDir, acQuery, "DumpIt", NameStr, 0, 0

    

    OldName = cOutputDir & NameStr & ".dbf"

    newname = cOutputDir & NameStr & ".AD2"

    Name OldName As newname

    

    qdfNew.SQL = "SELECT ExVehicle.* From ExVehicle WHERE (((ExVehicle.V_MAKEDESC)='" & FileVar & "'));"

    DoCmd.TransferDatabase acExport, "dbase IV", cOutputDir, acQuery, "DumpIt", NameStr, 0, 0

    

    OldName = cOutputDir & NameStr & ".dbf"

    newname = cOutputDir & NameStr & ".VEH"

    Name OldName As newname

      

    Stats.MoveNext

  

  Loop

  

  db.QueryDefs.Delete qdfNew.Name

  

  Stats.Close

  db.Execute "ClrExportStatus"

  DoCmd.SetWarnings True

  MsgBox "Export to Pathways Complete", vbInformation, "Pathways Export"
 

End Function

Open in new window

0
 

Author Comment

by:hapropper
ID: 24072796
I tried the "cleaned-up" version from aikimark (thanks!) and get an error 3734 on the Set db=Currentdb line. I changed the Dim statement to DAO.Database and got past that error. Now I get an error 3167 "Record is deleted" on line 44 of the above code.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 24073040
try
Dim Stats As DAO.Recordset

or
  Set Stats = dbs.OpenRecordset("ExEnvelope")

================
Is anyone else possibly updating this table when this routine runs?
0
 

Author Comment

by:hapropper
ID: 24073354
I made those changes to the code and ran it on a single PC and still get the error 3167 "Record is deleted" on line 44 of the above code.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 24073390
What is ExEnvelope?

Have you repaired/compacted the database recently?
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 24074249
hapropper,

Just so we are clear, ...because you ignored both of my posts, and never replied.

Testing this one file at a time is not a valild option?

If an experts comments are not helpful, as a courtesy, please reply to the expert explaing why.

JeffCoachman
0
 
LVL 45

Expert Comment

by:aikimark
ID: 24074306
@JeffCoachman

"Does this file need/have an extension?:
    c:\Pathways\Data\EXTCOMM\EMSIN"

With dbase tables, the name of the database is the path where the table files (*.dbf) are located.
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 24074736
Thanks, aikimark

I was just wondering why the Asker had not repiled to my suggestion of creating one file at a time.

It seems like you have got a handle on this though.
;-)

Jeff
0
 

Author Comment

by:hapropper
ID: 24076627
I apologize for my lack of posting and response etiquette. I will try the one file at a time process today and post my results.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 24076903
@Jeff

I don't think I have a clue, much less a handle, on the cause of this problem.
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 24077708
hapropper,

Don't get me wrong, you can try any experts suggestion you like.

My concern was that if you thought that my approach was not applicable, let me know.

The important thing is that you get your issue resolved.

Keep us posted on your progress.

;-)

JeffCoachman
0
 

Author Comment

by:hapropper
ID: 24129672
Something funky is going on...

I am now getting an error 3045 "Could not use c:\ccs\ccs97.mdb - file already in use" on line 20 of the code (Set db = Currentdb).

The strange thing is that this code worked without errors for about a year and now all sorts strange errors are occurring.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 24129793
I don't understand, line 20 is
db.Execute "XEnvelope"

Is this code running inside the ccs97.mdb database?!?  If so, that would explain a lot.

What is the CurrentDB database?

Are there any linked tables from ccs97.mdb into your database or anyone else's database?

Is there an c:\ccs\ccs97.LDB file?  If so, you need to open that database manually and repair/compact the database.
0
 

Author Comment

by:hapropper
ID: 24130269
If you look at the original code snippet -line 20 is Set db = Currentdb...

Yes this code is running inside of the ccs97.mdb database and CurrentDB is ccs97.

Basically ccs97 is like the "executable" and ccs97_be.mdb is the database (with most of the tables).

I create temporary tables and queries in ccs97 during this routine.

The .ldb file is created when I open the ccs97.mdb file. I have tried compacting and reparing the ccs97.mdb file and still get the same errors.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 24130382
Does ccs97_be.ldb exist?  (my appologies, I meant this one in my prior post)

In fact, most of the ccs97 questions should have been ccs97_be questions.  Please reanswer the prior ccs97 questions using ccs97_be.mdb.

Does this problem exist using the streamlined code I posted?

An unanswered question from a prior post: "What is ExEnvelope?"

=================
Note: It is difficult to know which code set is giving you problems.  Please let us know if you have reverted back to the original code and why you gave up on the streamlined code.
0
 

Accepted Solution

by:
hapropper earned 0 total points
ID: 24290484
I am using the original code and by placing a read of the drive contents after each iteration I was bale to make the code work.
0

Featured Post

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Join & Write a Comment

Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now