[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

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

Posted on 2009-04-05
21
Medium Priority
?
284 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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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 46

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 46

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 46

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 46

Expert Comment

by:aikimark
ID: 24073390
What is ExEnvelope?

Have you repaired/compacted the database recently?
0
 
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 46

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 46

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 46

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 46

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

[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Did you know that more than 4 billion data records have been recorded as lost or stolen since 2013? It was a staggering number brought to our attention during last week’s ManageEngine webinar, where attendees received a comprehensive look at the ma…
In a use case, a user needs to close an opened report by simply pressing the Escape (Esc) key. This can be done by adding macro code in Report_KeyPress or Report_KeyDown event.
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…
Suggested Courses
Course of the Month19 days, 16 hours left to enroll

872 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