Solved

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

Posted on 2009-04-05
21
273 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
Use Case: Protecting a Hybrid Cloud Infrastructure

Microsoft Azure is rapidly becoming the norm in dynamic IT environments. This document describes the challenges that organizations face when protecting data in a hybrid cloud IT environment and presents a use case to demonstrate how Acronis Backup protects all data.

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

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

832 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